Download
(require 'bookmark)
(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)))
(defalias 'bmkp-bookmark-data-from-record 'bookmark-get-bookmark-record)
(defalias 'bmkp-bookmark-name-from-record 'bookmark-name-from-full-record)
(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)))
(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))))
(defmacro bmkp-define-next+prev-cycle-commands (type)
"Define `next' and `previous' commands for bookmarks of type TYPE."
`(progn
(defun ,(intern (format "bmkp-next-%s-bookmark" type)) (n &optional startoverp)
,(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" type)) n startoverp))
(defun ,(intern (format "bmkp-previous-%s-bookmark" type)) (n &optional startoverp)
,(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" type)) (- n) startoverp))
(defun ,(intern (format "bmkp-next-%s-bookmark-repeat" type)) (arg)
,(format "Jump to the Nth-next %s bookmark.
This is a repeatable version of `bmkp-next-%s-bookmark'.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one (and no repeat)." type type)
(interactive "P")
(require 'repeat)
(bmkp-repeat-command ',(intern (format "bmkp-next-%s-bookmark" type))))
(defun ,(intern (format "bmkp-previous-%s-bookmark-repeat" type)) (arg)
,(format "Jump to the Nth-previous %s bookmark.
See `bmkp-next-%s-bookmark-repeat'." type type)
(interactive "P")
(require 'repeat)
(bmkp-repeat-command ',(intern (format "bmkp-previous-%s-bookmark" type))))))
(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)))
(push (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 (equal bmkp-sort-comparer ',comparer))
(setq bmkp-sort-comparer ',comparer
bmkp-reverse-sort-p nil))
(
(not bmkp-reverse-sort-p)
(setq bmkp-reverse-sort-p t))
(t
(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
(bmkp-bmenu-goto-bookmark-named current-bmk)))
(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)"))))))))
(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 (bookmark-get-bookmark b1))
(setq b2 (bookmark-get-bookmark b2))
(let (a1 a2)
(cond (
(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 (
(and a1 a2)
(setq a1 (nth ,att-nb a1)
a2 (nth ,att-nb a2))
(when (consp a1) (setq a1 (bmkp-float-time a1)))
(when (consp a2) (setq a2 (bmkp-float-time a2)))
(cond (
(numberp a1)
(cond ((< a1 a2) '(t))
((> a1 a2) '(nil))
(t nil)))
((= 0 ,att-nb)
(cond ((and a2 (not a1)) '(t))
((and a1 (not a2)) '(nil))
((and (eq t a2) (not (eq t a1))) '(t))
((and (eq t a1) (not (eq t a2))) '(t))
((and (stringp a1) (stringp a2))
(if (string< a1 a2) '(t) '(nil)))
(t nil)))
((stringp a1)
(cond ((string< a1 a2) '(t))
((string< a2 a1) '(nil))
(t nil)))
((eq ,att-nb 9)
(cond ((and a2 (not a1)) '(t))
((and a1 (not a2)) '(nil))
(t nil)))))
(
a1
'(t))
(
a2
'(nil))
(
t
nil)))
(
(bmkp-local-file-bookmark-p b1)
'(t))
(
(bmkp-local-file-bookmark-p b2)
'(nil))
(t
nil)))))
(defmacro bmkp-menu-bar-make-toggle (name variable doc message help &rest body)
"Return a valid `menu-bar-make-toggle' call in Emacs 20 or later.
NAME is the name of the toggle command to define.
VARIABLE is the variable to set.
DOC is the menu-item name.
MESSAGE is the toggle message, minus status.
HELP is `:help' string.
BODY is the function body to use. If present, it is responsible for
setting the variable and displaying a status message (not MESSAGE)."
(if (< emacs-major-version 21)
`(menu-bar-make-toggle ,name ,variable ,doc ,message ,@body)
`(menu-bar-make-toggle ,name ,variable ,doc ,message ,help ,@body)))
(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))
(provide 'bookmark+-mac)