EmacsWiki: bookmark+-mac.el (original) (raw)

Download Git Homepage

;;; bookmark+-mac.el --- Macros for Bookmark+. -- lexical-binding:t -- ;; ;; Filename: bookmark+-mac.el ;; Description: Macros for Bookmark+. ;; Author: Drew Adams ;; Maintainer: Drew Adams ;; Copyright (C) 2000-2024, Drew Adams, all rights reserved. ;; Created: Sun Aug 15 11:12:30 2010 (-0700) ;; Last-Updated: Sun Sep 15 18:09:29 2024 (-0700) ;; By: dradams ;; Update #: 238 ;; URL: https://www.emacswiki.org/emacs/download/bookmark%2b-mac.el ;; Doc URL: https://www.emacswiki.org/emacs/BookmarkPlus ;; Keywords: bookmarks, bookmark+, placeholders, annotations, search, info, url, eww, w3m, gnus ;; Compatibility: GNU Emacs: 20.x, 21.x, 22.x, 23.x, 24.x, 25.x, 26.x ;; ;; Features that might be required by this library: ;; ;; None ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Commentary: ;; ;; Macros for Bookmark+. ;; ;; The Bookmark+ libraries are these: ;; ;; bookmark+.el' - main (driver) library ;; bookmark+-mac.el' - Lisp macros (this file) ;; bookmark+-bmu.el' - code for the Bookmark List' (bmenu) ;; bookmark+-1.el' - other (non-bmenu) required code ;; bookmark+-lit.el' - (optional) code for highlighting bookmarks ;; bookmark+-key.el' - key and menu bindings ;; ;; bookmark+-doc.el' - documentation (comment-only file) ;; bookmark+-chg.el' - change log (comment-only file) ;; ;; The documentation (in bookmark+-doc.el') includes how to ;; byte-compile and install Bookmark+. The documentation is also ;; available in these ways: ;; ;; 1. From the bookmark list (C-x r l'): ;; Use ?' to show the current bookmark-list status and general ;; help, then click link Doc in Commentary' or link Doc on the ;; Web'. ;; ;; 2. From the Emacs-Wiki Web site: ;; https://www.emacswiki.org/emacs/BookmarkPlus. ;; ;; 3. From the Bookmark+ group customization buffer: ;; M-x customize-group bookmark-plus', then click link ;; Commentary'. ;; ;; (The commentary links in #1 and #3 work only if you have library ;; bookmark+-doc.el' in your load-path'.) ;; ;; ;; ****** NOTE ****** ;; ;; WHENEVER you update Bookmark+ (i.e., download new versions of ;; Bookmark+ source files), I recommend that you do the ;; following: ;; ;; 1. Delete ALL existing BYTE-COMPILED Bookmark+ files ;; (bookmark+*.elc). ;; 2. Load Bookmark+ (load-library' or require'). ;; 3. Byte-compile the source files. ;; ;; In particular, ALWAYS LOAD bookmark+-mac.el' (not ;; bookmark+-mac.elc') BEFORE YOU BYTE-COMPILE new versions of ;; the files, in case there have been any changes to Lisp macros ;; (in `bookmark+-mac.el'). ;; ;; (This is standard procedure for Lisp: code that depends on ;; macros needs to be byte-compiled anew after loading the ;; updated macros.) ;; ;; ******************

;;(@> "Index") ;; ;; If you have library linkd.el' and Emacs 22 or later, load ;; linkd.el' and turn on linkd-mode' now. It lets you easily ;; navigate around the sections of this doc. Linkd mode will ;; highlight this Index, as well as the cross-references and section ;; headings throughout this file. You can get linkd.el' here: ;; https://www.emacswiki.org/emacs/download/linkd.el. ;; ;; (@> "Things Defined Here") ;; (@> "Functions") ;; (@> "Macros")

;;(@* "Things Defined Here") ;; ;; Things Defined Here ;; ------------------- ;; ;; Macros defined here: ;; ;; bmkp-define-cycle-command', bmkp-define-file-sort-predicate', ;; bmkp-define-history-variables', ;; bmkp-define-next+prev-cycle-commands', ;; bmkp-define-show-only-command', bmkp-define-sort-command', ;; bmkp-define-type-from-hander', bmkp-lexlet', bmkp-lexlet*', ;; bmkp-make-plain-predicate', bmkp-menu-bar-make-toggle', ;; bmkp-with-bookmark-dir', bmkp-with-help-window', ;; bmkp-with-output-to-plain-temp-buffer'. ;; ;; Non-interactive functions defined here: ;; ;; bmkp-bookmark-data-from-record', ;; bmkp-bookmark-name-from-record', ;; bmkp-replace-regexp-in-string', bmkp-types-alist', ;; bookmark-name-from-full-record', bookmark-name-from-record'. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;; This program is free software; you can redistribute it and/or ;; modify it under the terms of the GNU General Public License as ;; published by the Free Software Foundation; either version 3, or ;; (at your option) any later version. ;; ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;; ;; You should have received a copy of the GNU General Public License ;; along with this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth ;; Floor, Boston, MA 02110-1301, USA. ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;; Code:

;;;;;;;;;;;;;;;;;;;;;;;

(require 'bookmark) ;; bookmark-bmenu-bookmark, bookmark-bmenu-ensure-position, ;; bookmark-bmenu-surreptitiously-rebuild-list, bmkp-get-bookmark, ;; bookmark-get-filename

;;(@* "Functions")

;; Some general Renamings. ;; ;; 1. Fix incompatibility introduced by gratuitous Emacs name change. ;; (cond ((and (fboundp 'bookmark-name-from-record) (not (fboundp 'bookmark-name-from-full-record))) (defalias 'bookmark-name-from-full-record 'bookmark-name-from-record)) ((and (fboundp 'bookmark-name-from-full-record) (not (fboundp 'bookmark-name-from-record))) (defalias 'bookmark-name-from-record 'bookmark-name-from-full-record)))

;; 2. The vanilla name of the first is misleading, as it returns only the cdr of the record. ;; The second is for consistency. ;; (defalias 'bmkp-bookmark-data-from-record 'bookmark-get-bookmark-record) (defalias 'bmkp-bookmark-name-from-record 'bookmark-name-from-full-record)

;; (eval-when-compile (require 'bookmark+-bmu)) ;; bmkp-assoc-delete-all, bmkp-bmenu-barf-if-not-in-menu-list, ;; bmkp-bmenu-goto-bookmark-named, bmkp-sort-orders-alist

;; (eval-when-compile (require 'bookmark+-1)) ;; bmkp-file-bookmark-p, bmkp-float-time, bmkp-local-file-bookmark-p, ;; bmkp-msg-about-sort-order, bmkp-reverse-sort-p, bmkp-sort-comparer

;;; This is also defined in bookmark+-bmu.el'. It is used here to produce the code for ;;; bmkp-define-show-only-command' and `bmkp-define-sort-command'. ;;; (defun bmkp-replace-regexp-in-string (regexp rep string &optional fixedcase literal subexp start) "Replace all matches for REGEXP with REP in STRING and return STRING." (if (fboundp 'replace-regexp-in-string) ; Emacs > 20. (replace-regexp-in-string regexp rep string fixedcase literal subexp start) (if (string-match regexp string) (replace-match rep nil nil string) string))) ; Emacs 20

;;(@* "Macros")

;;; Macros -----------------------------------------------------------

;; Same as icicle-with-help-window' in icicles-mac.el'. ;;;###autoload (autoload 'bmkp-with-help-window "bookmark+") (defmacro bmkp-with-help-window (buffer &rest body) "with-help-window', if available; else with-output-to-temp-buffer'." (if (fboundp 'with-help-window) (with-help-window ,buffer ,@body) (with-output-to-temp-buffer ,buffer ,@body)))

(put 'bmkp-with-help-window 'common-lisp-indent-function '(4 &body))

;;;###autoload (autoload 'bmkp-with-output-to-plain-temp-buffer "bookmark+") (defmacro bmkp-with-output-to-plain-temp-buffer (buf &rest body) "Like with-output-to-temp-buffer', but with no Help' navigation stuff." `(unwind-protect (progn (remove-hook 'temp-buffer-setup-hook 'help-mode-setup) (remove-hook 'temp-buffer-show-hook 'help-mode-finish) (with-output-to-temp-buffer ,buf ,@body)) (add-hook 'temp-buffer-setup-hook 'help-mode-setup) (add-hook 'temp-buffer-show-hook 'help-mode-finish)))

(put 'bmkp-with-output-to-plain-temp-buffer 'common-lisp-indent-function '(4 &body))

;;;###autoload (autoload 'bmkp-make-plain-predicate "bookmark+") (defmacro bmkp-make-plain-predicate (pred &optional final-pred) "Return a plain predicate that corresponds to component-predicate PRED. PRED and FINAL-PRED correspond to their namesakes in `bmkp-sort-comparer' (which see).

PRED should return (t)', (nil)', or nil.

Optional arg FINAL-PRED is the final predicate to use if PRED cannot decide (returns nil). If FINAL-PRED is nil, then bmkp-alpha-p', the plain-predicate equivalent of bmkp-alpha-cp' is used as the final predicate." `(lambda (b1 b2) (let ((res (funcall ',pred b1 b2))) (if res (car res) (funcall ',(or final-pred 'bmkp-alpha-p) b1 b2)))))

;;;###autoload (autoload 'bmkp-define-cycle-command "bookmark+") (defmacro bmkp-define-cycle-command (type &optional otherp) "Define a cycling command for bookmarks of type TYPE. Non-nil OTHERP means define a command that cycles in another window." (defun ,(intern (format "bmkp-cycle-%s%s" type (if otherp "-other-window" ""))) (increment &optional startoverp) ,(if otherp (format "Same as bmkp-cycle-%s', but use other window." type) (format "Cycle through %s bookmarks by INCREMENT (default: 1). Positive INCREMENT cycles forward. Negative INCREMENT cycles backward. Interactively, the prefix arg determines INCREMENT: Plain `C-u': 1 otherwise: the numeric prefix arg value

Plain `C-u' also means start over at first bookmark.

In Lisp code: Non-nil STARTOVERP means reset `bmkp-current-nav-bookmark' to the first bookmark in the navlist." type)) (interactive (let ((startovr (consp current-prefix-arg))) (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr))) (let ((bmkp-nav-alist (bmkp-sort-omit (,(intern (format "bmkp-%s-alist-only" type)))))) (bmkp-cycle increment ,otherp startoverp))))

;;;###autoload (autoload 'bmkp-define-next+prev-cycle-commands "bookmark+") (defmacro bmkp-define-next+prev-cycle-commands (type &optional otherp) "Define next' and previous' commands for bookmarks of type TYPE. Non-nil OTHERP means define a command that cycles in another window." (progn ;; next' command. (defun ,(intern (format "bmkp-next-%s-bookmark%s" type (if otherp "-other-window" ""))) (n &optional startoverp) ,(if otherp (format "Same as bmkp-next-%s-bookmark', but use other window." type) (format "Jump to the Nth-next %s bookmark. N defaults to 1, meaning the next one. Plain C-u' means start over at the first one. See also `bmkp-cycle-%s'." type type)) (interactive (let ((startovr (consp current-prefix-arg))) (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr))) (,(intern (format "bmkp-cycle-%s%s" type (if otherp "-other-window" ""))) n startoverp))

;; `previous' command.
(defun ,(intern (format "bmkp-previous-%s-bookmark%s" type (if otherp "-other-window" "")))
    (n &optional startoverp)
  ,(if otherp
       (format "Same as `bmkp-previous-%s-bookmark', but use other window." type)
       (format "Jump to the Nth-previous %s bookmark.

See `bmkp-next-%s-bookmark'." type type)) (interactive (let ((startovr (consp current-prefix-arg))) (list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr))) (,(intern (format "bmkp-cycle-%s%s" type (if otherp "-other-window" ""))) (- n) startoverp))

;; `next' repeating command.
(defun ,(intern (format "bmkp-next-%s-bookmark%s-repeat"
                        type
                        (if otherp "-other-window" "")))
    ()
  ,(if otherp
       (format "Same as `bmkp-next-%s-bookmark-repeat', but use other window." type)
       (format "Jump to the next %s bookmark.

This is a repeatable version of `bmkp-next-%s-bookmark'." type type)) (interactive) (require 'repeat) (bmkp-repeat-command ',(intern (format "bmkp-next-%s-bookmark%s" type (if otherp "-other-window" "")))))

;; `previous repeating command.
(defun ,(intern (format "bmkp-previous-%s-bookmark%s-repeat"
                        type
                        (if otherp "-other-window" "")))
    ()
  ,(if otherp
       (format "Same as `bmkp-previous-%s-bookmark-repeat', but use other window." type)
       (format "Jump to the previous %s bookmark.

See `bmkp-next-%s-bookmark-repeat'." type type)) (interactive) (require 'repeat) (bmkp-repeat-command ',(intern (format "bmkp-previous-%s-bookmark%s" type (if otherp "-other-window" "")))))))

;; We don't bother making this hygienic. Presumably only the Bookmark+ code will call it. ;;;###autoload (autoload 'bmkp-define-show-only-command "bookmark+") (defmacro bmkp-define-show-only-command (type doc-string filter-function) "Define a command to show only bookmarks of TYPE in Bookmark List. TYPE is a short string or symbol describing the type of bookmarks.

The new command is named bmkp-bmenu-show-only-TYPED-bookmarks', where TYPED is TYPE, but with any spaces replaced by hyphens (-'). Example: bmkp-bmenu-show-only-tagged-bookmarks', for TYPE tagged'.

DOC-STRING is the doc string of the new command.

The command shows only the bookmarks allowed by FILTER-FUNCTION.

In case of error, variables bmkp-bmenu-filter-function', bmkp-bmenu-title', and bmkp-latest-bookmark-alist' are reset to their values before the command was invoked." (unless (stringp type) (setq type (symbol-name type))) (let* ((type-- (bmkp-replace-regexp-in-string "\\s-+" "-" type)) (command (intern (format "bmkp-bmenu-show-only-%s-bookmarks" type--)))) (progn (defun ,command () ,doc-string (interactive) (bmkp-bmenu-barf-if-not-in-menu-list) (let ((orig-filter-fn bmkp-bmenu-filter-function) (orig-title bmkp-bmenu-title) (orig-latest-alist bmkp-latest-bookmark-alist)) (condition-case err (progn (setq bmkp-bmenu-filter-function ',filter-function bmkp-bmenu-title ,(format "%s Bookmarks" (capitalize type))) (let ((bookmark-alist (funcall bmkp-bmenu-filter-function))) (setq bmkp-latest-bookmark-alist bookmark-alist) (bookmark-bmenu-list 'filteredp)) (when (interactive-p) (bmkp-msg-about-sort-order (bmkp-current-sort-order) ,(format "Only %s bookmarks are shown" type)))) (error (progn (setq bmkp-bmenu-filter-function orig-filter-fn bmkp-bmenu-title orig-title bmkp-latest-bookmark-alist orig-latest-alist) (error "%s" (error-message-string err))))))))))

;;;###autoload (autoload 'bmkp-define-sort-command "bookmark+") (defmacro bmkp-define-sort-command (sort-order comparer doc-string) "Define a command to sort bookmarks in the bookmark list by SORT-ORDER. SORT-ORDER is a short string or symbol describing the sorting method. Examples: "by last access time", "by bookmark name".

The new command is named by replacing any spaces in SORT-ORDER with hyphens (-') and then adding the prefix bmkp-bmenu-sort-'. Example: bmkp-bmenu-sort-by-bookmark-name', for SORT-ORDER by bookmark name'.

COMPARER compares two bookmarks, returning non-nil if and only if the first bookmark sorts before the second. It must be acceptable as a value of bmkp-sort-comparer'. That is, it is either nil, a predicate, or a list ((PRED...) FINAL-PRED). See the doc for bmkp-sort-comparer'.

DOC-STRING is the doc string of the new command." (unless (stringp sort-order) (setq sort-order (symbol-name sort-order))) (let ((command (intern (concat "bmkp-bmenu-sort-" (bmkp-replace-regexp-in-string "\s-+" "-" sort-order))))) `(progn (setq bmkp-sort-orders-alist (bmkp-assoc-delete-all ,sort-order (copy-sequence bmkp-sort-orders-alist))) (setq bmkp-sort-orders-alist (cons (cons ,sort-order ',comparer) bmkp-sort-orders-alist)) (defun ,command () ,(concat doc-string "\nRepeating this command cycles among normal sort, reversed
sort, and unsorted.") (interactive) (bmkp-bmenu-barf-if-not-in-menu-list) (cond (;; Not this sort order - make it this sort order. (not (equal bmkp-sort-comparer ',comparer)) (setq bmkp-sort-comparer ',comparer bmkp-reverse-sort-p nil)) (;; Not this sort order reversed - make it reversed. (not bmkp-reverse-sort-p) (setq bmkp-reverse-sort-p t)) (t;; This sort order reversed. Change to unsorted. (setq bmkp-sort-comparer nil))) (message "Sorting...") (bookmark-bmenu-ensure-position) (let ((current-bmk (bookmark-bmenu-bookmark))) (bookmark-bmenu-surreptitiously-rebuild-list) (when current-bmk ; Should be non-nil, but play safe. (bmkp-bmenu-goto-bookmark-named current-bmk))) ; Put cursor back on right line. (when (interactive-p) (bmkp-msg-about-sort-order ,sort-order nil (cond ((and (not bmkp-reverse-sort-p) (equal bmkp-sort-comparer ',comparer)) "(Repeat: reverse)") ((equal bmkp-sort-comparer ',comparer) "(Repeat: unsorted)") (t "(Repeat: sort)"))))))))

;;;###autoload (autoload 'bmkp-define-file-sort-predicate "bookmark+") (defmacro bmkp-define-file-sort-predicate (att-nb) "Define a predicate for sorting bookmarks by file attribute ATT-NB. See function `file-attributes' for the meanings of the various file attribute numbers.

String attribute values sort alphabetically; numerical values sort numerically; nil sorts before t.

For ATT-NB 0 (file type), a file sorts before a symlink, which sorts before a directory.

For ATT-NB 2 or 3 (uid, gid), a numerical value sorts before a string value.

A bookmark that has file attributes sorts before a bookmark that does not. A file bookmark sorts before a non-file bookmark. Only local files are tested for attributes - remote-file bookmarks are treated here like non-file bookmarks." `(defun ,(intern (format "bmkp-file-attribute-%d-cp" att-nb)) (b1 b2) ,(format "Sort file bookmarks by attribute %d. Sort bookmarks with file attributes before those without attributes Sort file bookmarks before non-file bookmarks. Treat remote file bookmarks like non-file bookmarks.

B1 and B2 are full bookmarks (records) or bookmark names. If either is a record then it need not belong to `bookmark-alist'." att-nb) (setq b1 (bmkp-get-bookmark b1)) (setq b2 (bmkp-get-bookmark b2)) (let (a1 a2) (cond (;; Both are file bookmarks. (and (bmkp-file-bookmark-p b1) (bmkp-file-bookmark-p b2)) (setq a1 (file-attributes (bookmark-get-filename b1)) a2 (file-attributes (bookmark-get-filename b2))) (cond (;; Both have attributes. (and a1 a2) (setq a1 (nth ,att-nb a1) a2 (nth ,att-nb a2)) ;; Convert times and maybe inode number to floats. ;; The inode conversion is kludgy, but is probably OK in practice. (when (consp a1) (setq a1 (bmkp-float-time a1))) (when (consp a2) (setq a2 (bmkp-float-time a2))) (cond (;; (1) links, (2) maybe uid, (3) maybe gid, (4, 5, 6) times ;; (7) size, (10) inode, (11) device. (numberp a1) (cond ((< a1 a2) '(t)) ((> a1 a2) '(nil)) (t nil))) ((= 0 ,att-nb) ; (0) file (nil) < symlink (string) < dir (t) (cond ((and a2 (not a1)) '(t)) ; file vs (symlink or dir) ((and a1 (not a2)) '(nil)) ((and (eq t a2) (not (eq t a1))) '(t)) ; symlink vs dir ((and (eq t a1) (not (eq t a2))) '(t)) ((and (stringp a1) (stringp a2)) (if (string< a1 a2) '(t) '(nil))) (t nil))) ((stringp a1) ; (2, 3) string uid/gid, (8) modes (cond ((string< a1 a2) '(t)) ((string< a2 a1) '(nil)) (t nil))) ((eq ,att-nb 9) ; (9) gid would change if re-created. nil < t (cond ((and a2 (not a1)) '(t)) ((and a1 (not a2)) '(nil)) (t nil))))) (;; First has attributes, but not second. a1 '(t)) (;; Second has attributes, but not first. a2 '(nil)) (;; Neither has attributes. t nil))) (;; First is a file, second is not. (bmkp-local-file-bookmark-p b1) '(t)) (;; Second is a file, first is not. (bmkp-local-file-bookmark-p b2) '(nil)) (t;; Neither is a file. nil)))))

;;; This is also defined in bookmark+-1.el'. It is used here to produce the code for ;;; bmkp-define-history-variables' and bmkp-define-sort-command'. ;;; (defun bmkp-types-alist () "Alist of bookmark types used by bmkp-jump-to-type'. Keys are bookmark type names. Values are corresponding history variables. The alist is used in commands such as bmkp-jump-to-type'." (let ((entries ())) (mapatoms (lambda (sym) (let ((name (symbol-name sym))) (when (string-match "\\bmkp-\(.+\)-alist-only\'" name) (push (cons (match-string 1 name) (intern (format "bmkp-%s-history" (match-string 1 name)))) entries))))) entries))

;; Macro that defines Bookmark+ history variables. ;; Use this after you define any new filter function, bmkp-*-alist-only', ;; for a new kind of bookmark. ;; ;;;###autoload (autoload 'bmkp-define-history-variables "bookmark+") (defmacro bmkp-define-history-variables () "Create and eval defvars for Bookmark+ history variables. The variables are the cdrs of bmkp-types-alist'. They are used in commands such as bmkp-jump-to-type'." (let ((dfvars ())) (dolist (entry (bmkp-types-alist)) (push (defvar ,(cdr entry) () ,(format "History for %s bookmarks." (car entry))) dfvars)) `(progn ,@dfvars)))

;; This macro is not used in the Bookmark+ code. It's available for users who want to define ;; simple bookmark types that are based only on a handler. ;; ;;;###autoload (autoload 'bmkp-define-type-from-hander "bookmark+") (defmacro bmkp-define-type-from-hander (type handler) "Define a TYPE of bookmarks based only on a HANDLER function. TYPE is a short string or symbol.

Define predicate `bmkp-TYPE-bookmark-p', which returns non-nil if its bookmark argument has HANDLER.

Define filter function `bmkp-TYPE-alist-only', which returns only the TYPE bookmarks from the current bookmark list.

Define command bmkp-bmenu-show-only-TYPE-bookmarks', which shows only the TYPE bookmarks, in the bookmark-list display." (let ((predicate-doc (format "Return non-nil if BOOKMARK is a %s bookmark." type)) (predicate-symb (intern (format "bmkp-%s-bookmark-p" type))) (predicate (eq (bookmark-get-handler bmk) ',handler)) (alist-only-doc (format "bookmark-alist', filtered to retain only %s bookmarks." type)) (alist-only-fn (intern (format "bmkp-%s-alist-only" type))) (show-only-doc (format "Display (only) the %s bookmarks." type))) (progn (defun ,predicate-symb (bookmark) ,predicate-doc ,predicate) (defun ,alist-only-fn () ,alist-only-doc (bookmark-maybe-load-default-file) (bmkp-remove-if-not (lambda (bmk) ,predicate) bookmark-alist)) (bmkp-define-show-only-command ,type ,show-only-doc ,alist-only-fn) (bmkp-define-history-variables))))

;; This is compatible with Emacs 20 and later. ;;;###autoload (autoload 'bmkp-menu-bar-make-toggle "bookmark+") (defmacro bmkp-menu-bar-make-toggle (command variable item-name message help &optional setting-sexp &rest keywords) "Define a menu-bar toggle command. COMMAND (a symbol) is the toggle command to define. VARIABLE (a symbol) is the variable to set. ITEM-NAME (a string) is the menu-item name. MESSAGE is a format string for the toggle message, with %s for the new status. HELP (a string) is the :help' tooltip text and the doc string first line (minus final period) for the command. SETTING-SEXP is a Lisp sexp that sets VARIABLE, or it is nil meaning set it according to its defcustom' or using set-default'. KEYWORDS is a plist for menu-item' for keywords other than :help'." (progn (defun ,command (&optional interactively) ,(concat help ". In an interactive call, record this option as a candidate for saving by "Save Options" in Custom buffers.") (interactive "p") (if ,(if setting-sexp ,setting-sexp (progn (custom-load-symbol ',variable) (let ((set (or (get ',variable 'custom-set) 'set-default)) (get (or (get ',variable 'custom-get) 'default-value))) (funcall set ',variable (not (funcall get ',variable)))))) (message ,message "enabled globally") (message ,message "disabled globally")) ;; customize-mark-as-set' must only be called when a variable is set interactively, ;; because the purpose is to mark the variable as a candidate for Save Options', and we ;; do not want to save options that the user has already set explicitly in the init file. (when (and interactively (fboundp 'customize-mark-as-set)) (customize-mark-as-set ',variable))) '(menu-item ,item-name ,command :help ,help :button (:toggle . (and (default-boundp ',variable) (default-value ',variable))) ,@keywords)))

;;; Not used currently. Provided so you can use it in your own code, if appropriate. ;;;###autoload (autoload 'bmkp-with-bookmark-dir "bookmark+") (defmacro bmkp-with-bookmark-dir (bookmark &rest body) "Evaluate BODY forms with BOOKMARK location as default-directory'. If BOOKMARK has no location then use nil as default-directory'." `(let* ((loc (bookmark-location ,bookmark)) (default-directory (and (stringp loc) (not (member loc (list bmkp-non-file-filename "-- Unknown location --"))) (if (file-directory-p loc) loc (file-name-directory loc))))) ,@body))

;; These are needed because Emacs 29 removed lexical-let[*]'. ;; (defmacro bmkp-lexlet (&rest all) "lexical-let', if available and not lexical-binding'; else let'." (if (and (fboundp 'lexical-let) ; Emacs < 29 (or (not (boundp 'lexical-binding)) ; Emacs < 24.something (not lexical-binding))) ; Emacs >= 24.something (lexical-let ,@all) (let ,@all))) ; Emacs 29+

(defmacro bmkp-lexlet* (&rest all) "lexical-let*', if available and not lexical-binding'; else let*'." (if (and (fboundp 'lexical-let*) ; Emacs < 29 (or (not (boundp 'lexical-binding)) ; Emacs < 24.something (not lexical-binding))) ; Emacs >= 24.something (lexical-let* ,@all) `(let* ,@all)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(provide 'bookmark+-mac)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; bookmark+-mac.el ends here