Download
(unless (fboundp 'file-remote-p) (require 'ffap))
(eval-when-compile (require 'gnus))
(eval-when-compile (require 'gnus-sum))
(eval-when-compile (require 'cl))
(when (and (require 'thingatpt+ nil t)
(fboundp 'tap-put-thing-at-point-props))
(tap-define-aliases-wo-prefix)
(tap-put-thing-at-point-props))
(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)
(eval-when-compile
(or (condition-case nil
(load-library "bookmark+-mac")
(error nil))
(require 'bookmark+-mac)))
(put 'bmkp-with-output-to-plain-temp-buffer 'common-lisp-indent-function '(4 &body))
(eval-when-compile (require 'bookmark+-bmu))
(provide 'bookmark+-1)
(require 'bookmark+-1)
(defvar bmkp-auto-light-when-set)
(defvar bmkp-auto-light-when-jump)
(defvar bmkp-light-priorities)
(defvar bmkp-temporary-bookmarking-mode)
(defvar bmkp-global-auto-idle-bookmark-mode)
(defvar bookmark-current-point)
(defvar bookmark-edit-annotation-text-func)
(defvar bookmark-read-annotation-text-func)
(defvar bookmark-make-record-function)
(defvar desktop-basefilename)
(defvar desktop-base-file-name)
(defvar desktop-buffer-args-list)
(defvar desktop-delay-hook)
(defvar desktop-dirname)
(defvar desktop-file-modtime)
(defvar desktop-globals-to-save)
(defvar desktop-save-mode)
(defvar desktop-save)
(defvar dired-actual-switches)
(defvar dired-buffers)
(defvar dired-directory)
(defvar dired-guess-shell-case-fold-search)
(defvar dired-subdir-alist)
(defvar gnus-article-current)
(defvar Info-current-node)
(defvar Info-current-file)
(defvar Man-arguments)
(defvar read-file-name-completion-ignore-case)
(defvar last-repeatable-command)
(defvar w3m-current-title)
(defvar w3m-current-url)
(defvar w3m-mode-map)
(defvar wide-n-restrictions)
(defvar woman-last-file-name)
(defcustom bmkp-autofile-filecache 'cache-only
"*Whether Emacs filecache commands create/set an autofile bookmark.
The possible values:
`autofile+cache' - Whenever a file is added to the file cache, also
create/set an autofile bookmark for the file.
`autofile-only' - Create/set an autofile instead of caching the file.
`cache-only' - Add the file to the file cache. No autofile."
:type '(choice
(const :tag "Create/set an autofile bookmark instead of adding to file cache" autofile-only)
(const :tag "Create/set an autofile bookmark and add to file cache" autofile+cache)
(const :tag "Add to file cache only - do not create/set an autofile bookmark" cache-only))
:group 'bookmark-plus)
(defcustom bmkp-auto-idle-bookmark-min-distance 1000
"*Minimum number of chars between automatic bookmark positions."
:type '(choice
(const :tag "No minumum distance" nil)
(integer :tag "At least this many chars" :value 1000))
:group 'bookmark-plus)
(unless (fboundp 'define-minor-mode)
(defcustom bmkp-auto-idle-bookmark-mode nil
"*Non-nil means that bookmarks are created periodically automatically.
Setting this variable directly does not take effect
use either \\[customize] or command `bmkp-auto-idle-bookmark-mode'."
:set (lambda (symbol value) (bmkp-auto-idle-bookmark-mode (if value 1 -1)))
:initialize 'custom-initialize-default
:type 'boolean :group 'bookmark-plus :require 'bookmark+))
(defcustom bmkp-auto-idle-bookmark-mode-delay 60
"*Number of seconds delay before automatically setting a bookmark.
Such automatic bookmarking is controlled by
`bmkp-temporary-bookmarking-mode'."
:type 'integer :group 'bookmark-plus)
(defcustom bmkp-auto-idle-bookmark-mode-lighter " Auto-Bmk"
"*Lighter for `bmkp-auto-idle-bookmark-mode'.
This string shows in the mode line when `bmkp-auto-idle-bookmark-mode'
is enabled. Set this to nil or \"\" if you do not want any lighter."
:type 'string :group 'bookmark-plus)
(defcustom bmkp-auto-idle-bookmark-mode-set-function #'bmkp-set-autonamed-bookmark-at-line
"*Function used to set an automatic bookmark.
Used by `bmkp-temporary-bookmarking-mode'.
The default value, `bmkp-set-autonamed-bookmark-at-line', sets an
autonamed bookmark at the start of the current line. To bookmark the
current position, so you can have more than one automatic bookmark per
line, use `bmkp-set-autonamed-bookmark' instead."
:type 'function :group 'bookmark-plus)
(defcustom bmkp-autoname-bookmark-function 'bmkp-autoname-bookmark-function-default
"*Function to automatically name a bookmark at point (cursor position).
It should accept a buffer position as its (first) argument.
The name returned should match the application of
`bmkp-autoname-format' to the buffer name."
:type 'function :group 'bookmark-plus)
(defcustom bmkp-autoname-format (if (> emacs-major-version 21) "^[0-9]\\{9\\} %s" "^[0-9]+ %s")
"*Format string to match an autonamed bookmark name.
It must have a single `%s' to accept the buffer name."
:type 'string :group 'bookmark-plus)
(defcustom bmkp-autotemp-bookmark-predicates '(bmkp-autonamed-bookmark-p
bmkp-autonamed-this-buffer-bookmark-p)
"*Predicates for bookmarks to be set (created) as temporary bookmarks.
Each is typically a type predicate, but it can be any function that
accepts as its (first) argument a bookmark or bookmark name.
These are the predefined type predicates:
`bmkp-autofile-bookmark-p', `bmkp-autonamed-bookmark-for-buffer-p',
`bmkp-autonamed-bookmark-p', `bmkp-autonamed-this-buffer-bookmark-p',
`bmkp-bookmark-file-bookmark-p', `bmkp-bookmark-list-bookmark-p',
`bmkp-desktop-bookmark-p', `bmkp-dired-bookmark-p',
`bmkp-dired-this-dir-bookmark-p', `bmkp-file-bookmark-p',
`bmkp-file-remote-p', `bmkp-file-this-dir-bookmark-p',
`bmkp-function-bookmark-p', `bmkp-gnus-bookmark-p',
`bmkp-image-bookmark-p', `bmkp-info-bookmark-p',
`bmkp-last-specific-buffer-p', `bmkp-last-specific-file-p',
`bmkp-local-directory-bookmark-p', `bmkp-local-file-bookmark-p',
`bmkp-man-bookmark-p', `bmkp-non-file-bookmark-p',
`bmkp-region-bookmark-p', `bmkp-remote-file-bookmark-p',
`bmkp-sequence-bookmark-p', `bmkp-this-buffer-p', `bmkp-this-file-p',
`bmkp-url-bookmark-p', `bmkp-url-browse-bookmark-p',
`bmkp-variable-list-bookmark-p', `bmkp-w3m-bookmark-p'"
:type '(repeat symbol) :group 'bookmark-plus)
(defcustom bmkp-bookmark-name-length-max 70
"*Max number of chars for default name for a bookmark with a region."
:type 'integer :group 'bookmark-plus)
(defcustom bmkp-count-multi-mods-as-one-flag t
"*Non-nil means count multiple modifications as one.
This is for `bookmark-alist-modification-count'. Non-nil means that
when you invoke a command that acts on multiple bookmarks or acts in
multiple ways on one bookmark, all of changes together count as only
one moficication. That can prevent automatic saving of your bookmark
file during the sequence of modifications, so that when the command is
done you can choose not to save (i.e., to quit) if you like."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-crosshairs-flag (> emacs-major-version 21)
"*Non-nil means highlight with crosshairs when you visit a bookmark.
The highlighting is temporary - until your next action.
You need library `crosshairs.el' for this feature, and you need Emacs
22 or later.
NOTE: Crosshairs highlighting is shown in the buffer that is current
after jumping. If the bookmarked jumped to does not really have an
associated buffer, for example a bookmark with a handler such as
`w32-browser' that just invokes a separate, non-Emacs program, then
the current buffer after jumping will be the buffer before jumping.
If you use this option in Lisp code, you will want to add/remove
`bmkp-crosshairs-highlight' to/from `bookmark-after-jump-hook'."
:set (lambda (sym new-val)
(custom-set-default sym new-val)
(if (and bmkp-crosshairs-flag (> emacs-major-version 21)
(condition-case nil (require 'crosshairs nil t) (error nil)))
(add-hook 'bookmark-after-jump-hook 'bmkp-crosshairs-highlight)
(remove-hook 'bookmark-after-jump-hook 'bmkp-crosshairs-highlight)))
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-default-bookmark-name 'highlighted
"*Default bookmark name preference for accessing existing bookmarks.
\(The default name for a new bookmark is obtained using option
`bmkp-new-bookmark-default-names'.)
In `*Bookmark List*' use the name of the current line's bookmark.
Otherwise, if `bookmark+-lit.el' is not loaded then use the name of
the last-used bookmark in the current file.
Otherwise, use this option to determine the default, by preferring one
of the following, if available:
* a highlighted bookmark at point
* the last-used bookmark in the current file"
:type '(choice
(const :tag "Highlighted bookmark at point" highlighted)
(const :tag "Last used bookmark in same file" last-used))
:group 'bookmark-plus)
(when (fboundp 'defvaralias)
(defvaralias 'bmkp-default-handler-associations 'bmkp-default-handlers-for-file-types)
(make-obsolete-variable 'bmkp-default-handler-associations 'bmkp-default-handlers-for-file-types
"2012-02-27"))
(defcustom bmkp-default-handlers-for-file-types
(and (require 'dired-x)
(eval-when-compile (when (< emacs-major-version 21) (require 'cl)))
(let ((assns ()))
(dolist (shell-assn dired-guess-shell-alist-user)
(push (cons (car shell-assn)
`(lambda (bmk)
(dired-run-shell-command
(dired-shell-stuff-it ,(cadr shell-assn) (list (bookmark-get-filename bmk))
nil nil))))
assns))
assns))
"*File associations for bookmark handlers used for indirect bookmarks.
Each element of the alist is (REGEXP . COMMAND).
REGEXP matches a file name.
COMMAND is a sexp that evaluates to either a shell command (a string)
or an Emacs function (a symbol or a lambda form). The shell command
or Lisp function must accept a file-name argument.
Example value:
((\"\\\\.pdf$\" . \"AcroRd32.exe\")
(\"\\\\.ps$\" . \"gsview32.exe\")
(\"\\\\.html?$\" . browse-url)
(\"\\\\.doc$\" . w32-browser))
When you change this option using Customize, if you want to use a
literal string as COMMAND then you must double-quote the text:
\"...\". (But do not use double-quotes for the REGEXP.) If you want
to use a symbol as COMMAND, just type the symbol name (no quotes).
This option is used by `bmkp-default-handler-for-file' to determine
the default `file-handler' property for a given file bookmark. If a
given file name does not match this option, and if
`bmkp-guess-default-handler-for-file-flag' is non-nil, then
`bmkp-default-handler-for-file' tries to guess a shell command to use
in the default handler. For that it uses `dired-guess-default' and
\(Emacs 23+ only) mailcap entries, in that order."
:type '(alist :key-type
regexp :value-type
(sexp :tag "Shell command (string) or Emacs function (symbol or lambda form)"))
:group 'bookmark-plus)
(defcustom bmkp-desktop-no-save-vars '(search-ring regexp-search-ring kill-ring)
"*List of variables not to save when creating a desktop bookmark.
They are removed from `desktop-globals-to-save' for the duration of
the save (only)."
:type '(repeat (variable :tag "Variable")) :group 'bookmark-plus)
(defcustom bmkp-handle-region-function 'bmkp-handle-region-default
"*Function to handle a bookmarked region."
:type 'function :group 'bookmark-plus)
(defcustom bmkp-incremental-filter-delay (if (boundp 'bookmark-search-delay)
bookmark-search-delay
0.2)
"*Seconds to wait before updating display when filtering bookmarks."
:type 'number :group 'bookmark-plus)
(defcustom bmkp-last-as-first-bookmark-file bookmark-default-file
"*Whether to use the last-used bookmark file as the first used.
If nil then Emacs always uses the value of `bookmark-default-file' as
the initial bookmark file, in any given session.
If non-nil, Emacs uses the last bookmark file you used, in the last
Emacs session. If none was recorded then it uses
`bookmark-default-file'. The particular non-nil value must be a an
absolute file name \(possibly containing `~') - it is not expanded).
NOTE: A non-nil option value is overwritten by Bookmark+, so that it
becomes the last-used bookmark file. A nil value is never
overwritten."
:type '(choice
(const :tag "Use `bookmark-default-file' as initial bookmark file" nil)
(file :tag "Use last-used bookmark file as initial bookmark file"
:value "~/.emacs.bmk"))
:group 'bookmark)
(defcustom bmkp-menu-popup-max-length 20
"*Max number of bookmarks for `bookmark-completing-read' to use a menu.
When choosing a bookmark from a list of bookmarks using
`bookmark-completing-read', this controls whether to use a menu or
minibuffer input with completion.
If t, then always use a menu.
If nil, then never use a menu.
If an integer, then use a menu only if there are fewer bookmark
choices than the value."
:type '(choice
(integer :tag "Use a menu if there are fewer bookmark choices than this" 20)
(const :tag "Always use a menu to choose a bookmark" t)
(const :tag "Never use a menu to choose a bookmark" nil))
:group 'bookmark-plus)
(defcustom bmkp-new-bookmark-default-names
(let ((fns '((lambda () (let ((ff (function-called-at-point)))
(and ff (symbolp ff) (symbol-name ff)))))))
(when (fboundp 'region-or-non-nil-symbol-name-nearest-point)
(push 'region-or-non-nil-symbol-name-nearest-point fns))
fns)
"Functions to produce the default name for a new bookmark.
\(The default name for an *existing* bookmark is obtained using
`bmkp-default-bookmark-name'.)
The option value is a list of functions that do not require an
argument and return a string (or nil). They are invoked in order to
produce the default names.
The following names are also provided, after the names described
above: The value of variable `bookmark-current-bookmark' and the
return value of function `bookmark-buffer-name', in that order.
These latter names are the defaults provided by vanilla Emacs
`bookmark.el', so if you want the vanilla behavior then set the option
value to nil.
For non-interactive use of a default bookmark name, and for Emacs
prior to Emacs 23 even for interactive use, only the first default
name is used.
Some functions you might want to use in the option value:
* `region-or-non-nil-symbol-name-nearest-point'
* (lambda () (let ((ff (function-called-at-point)))
(and (symbolp ff) (symbol-name ff))))
* (lambda () (let ((vv (variable-at-point)))
(and (symbolp vv) (symbol-name vv))))
* `word-at-point'
* (lambda () (let ((ss (symbol-at-point)))
(and ss (symbol-name ss))))
The first of these is defined in library `thingatpt+.el'. It returns
the text in the region, if it is active and not empty. Otherwise it
returns the name of the (non-`nil') symbol nearest point, within
maximum search distances `tap-near-point-x-distance' (left and right)
and `tap-near-point-y-distance' (up and down)."
:type '(repeat function) :group 'bookmark-plus)
(defcustom bmkp-other-window-pop-to-flag t
"*Non-nil means other-window bookmark jumping uses `pop-to-buffer'.
Use nil if you want the vanilla Emacs behavior, which uses
`switch-to-buffer-other-window'. That creates a new window even if
there is already another window showing the buffer."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-prompt-for-tags-flag nil
"*Non-nil means `bookmark-set' prompts for tags (when called interactively)."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-region-search-size 40
"*Same as `bookmark-search-size', but specialized for bookmark regions."
:type 'integer :group 'bookmark-plus)
(defcustom bmkp-save-new-location-flag t
"*Non-nil means save automatically relocated bookmarks.
If nil, then the new bookmark location is visited, but it is not saved
as part of the bookmark definition."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-sequence-jump-display-function 'pop-to-buffer
"*Function used to display the bookmarks in a bookmark sequence."
:type 'function :group 'bookmark-plus)
(defcustom bmkp-show-end-of-region t
"*Show end of region with `exchange-point-and-mark' when activating a region.
If nil show only beginning of region."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-sort-comparer '((bmkp-info-cp bmkp-gnus-cp bmkp-url-cp bmkp-local-file-type-cp)
bmkp-alpha-p)
"*Predicate or predicates for sorting (comparing) bookmarks.
This defines the default sort for bookmarks in the bookmark list.
Various sorting commands, such as \\<bookmark-bmenu-mode-map>\
`\\[bmkp-bmenu-sort-by-bookmark-visit-frequency]', change the value of this
option dynamically (but they do not save the changed value).
The value must be one of the following:
* nil, meaning do not sort
* a predicate that takes two bookmarks as args
* a list of the form ((PRED...) FINAL-PRED), where each PRED and
FINAL-PRED are predicates that take two bookmarks as args
If the value is a list of predicates, then each PRED is tried in turn
until one returns a non-nil value. In that case, the result is the
car of that value. If no non-nil value is returned by any PRED, then
FINAL-PRED is used and its value is the result.
Each PRED should return `(t)' for true, `(nil)' for false, or nil for
undecided. A nil value means that the next PRED decides (or
FINAL-PRED, if there is no next PRED).
Thus, a PRED is a special kind of predicate that indicates either a
boolean value (as a singleton list) or \"I cannot decide - let the
next guy else decide\". (Essentially, each PRED is a hook function
that is run using `run-hook-with-args-until-success'.)
Examples:
nil - No sorting.
string-lessp - Single predicate that returns nil or non-nil.
((p1 p2)) - Two predicates `p1' and `p2', which each return
(t) for true, (nil) for false, or nil for undecided.
((p1 p2) string-lessp)
- Same as previous, except if both `p1' and `p2' return
nil, then the return value of `string-lessp' is used.
Note that these two values are generally equivalent, in terms of their
effect (*):
((p1 p2))
((p1) p2-plain) where p2-plain is (bmkp-make-plain-predicate p2)
Likewise, these three values generally act equivalently (*):
((p1))
(() p1-plain)
p1-plain where p1-plain is (bmkp-make-plain-predicate p1)
The PRED form lets you easily combine predicates: use `p1' unless it
cannot decide, in which case try `p2', and so on. The value ((p2 p1))
tries the predicates in the opposite order: first `p2', then `p1' if
`p2' returns nil.
Using a single predicate or FINAL-PRED makes it easy to reuse an
existing predicate that returns nil or non-nil.
You can also convert a PRED-type predicate (which returns (t), (nil),
or nil) into an ordinary predicate, by using function
`bmkp-make-plain-predicate'. That lets you reuse elsewhere, as
ordinary predicates, any PRED-type predicates you define.
For example, this defines a plain predicate to compare by URL:
(defalias 'bmkp-url-p (bmkp-make-plain-predicate 'bmkp-url-cp))
Note: As a convention, predefined Bookmark+ PRED-type predicate names
have the suffix `-cp' (for \"component predicate\") instead of `-p'.
--
* If you use `\\[bmkp-reverse-multi-sort-order]', then there is a difference in \
behavior between
(a) using a plain predicate as FINAL-PRED and
(b) using the analogous PRED-type predicate (and no FINAL-PRED).
In the latter case, `\\[bmkp-reverse-multi-sort-order]' affects when the predicate \
is tried and
its return value. See `bmkp-reverse-multi-sort-order'."
:type '(choice
(const :tag "None (do not sort)" nil)
(function :tag "Sorting Predicate")
(list :tag "Sorting Multi-Predicate"
(repeat (function :tag "Component Predicate"))
(choice
(const :tag "None" nil)
(function :tag "Final Predicate"))))
:group 'bookmark-plus)
(defcustom bmkp-su-or-sudo-regexp "\\(/su:\\|/sudo:\\)"
"*Regexp to recognize `su' or `sudo' Tramp bookmarks."
:type 'regexp :group 'bookmark-plus)
(defcustom bmkp-tags-for-completion 'current
"*List of strings used as tags for completion (not an alist).
The tags can be specified here individually or taken from (a) the
current bookmark list or (b) one or more bookmark files or both.
\(In Emacs 20 and 21, you cannot choose (b) when customizing, but if
\(b) was chosen using a later Emacs version then the option value can
still be used in Emacs 20 and 21.)
If a relative file name is specified for a bookmark file then the
current value of `default-directory' is used to find the file."
:type (if (> emacs-major-version 21)
'(choice
(const :tag "From current bookmarks only" current)
(list :tag "From current bookmarks and other sources"
(const :tag "" current)
(repeat :inline t :tag "Additional sources or specific tags"
(choice
(string :tag "Specific tag")
(cons :tag "All tags from a bookmark file"
(const :tag "" bmkfile) (file :must-match t)))))
(repeat :tag "Choose sources or specific tags"
(choice
(string :tag "Specific tag")
(cons :tag "All tags from a bookmark file"
(const :tag "" bmkfile) (file :must-match t)))))
'(choice
(const :tag "From current bookmarks only" current)
(repeat :tag "Choose sources or specific tags"
(choice
(string :tag "Specific tag")
(cons :tag "All tags from a bookmark file"
(const :tag "" bmkfile) (file :must-match t))))))
:group 'bookmark-plus)
(unless (fboundp 'define-minor-mode)
(defcustom bmkp-temporary-bookmarking-mode nil
"*Non-nil means that bookmarks are temporary (not recorded on disk).
Setting this variable directly does not take effect
use either \\[customize] or command `bmkp-temporary-bookmarking-mode'."
:set (lambda (symbol value) (bmkp-temporary-bookmarking-mode (if value 1 -1)))
:initialize 'custom-initialize-default
:type 'boolean :group 'bookmark-plus :require 'bookmark+))
(defcustom bmkp-temporary-bookmarking-mode-hook ()
"*Functions run after entering and exiting temporary-bookmarking mode."
:type 'hook :group 'bookmark-plus)
(defcustom bmkp-this-file/buffer-cycle-sort-comparer '((bmkp-position-cp))
"*`bmkp-sort-comparer' value for cycling this-file/buffer bookmarks.
Use bookmarks for the currently visited file or (non-file) buffer.
Some values you might want to use: ((bmkp-position-cp)),
((bmkp-bookmark-creation-cp)), ((bmkp-visited-more-cp)).
See `bmkp-sort-comparer'."
:type '(choice
(const :tag "None (do not sort)" nil)
(function :tag "Sorting Predicate")
(list :tag "Sorting Multi-Predicate"
(repeat (function :tag "Component Predicate"))
(choice
(const :tag "None" nil)
(function :tag "Final Predicate"))))
:group 'bookmark-plus)
(defcustom bmkp-guess-default-handler-for-file-flag nil
"*Non-nil means guess the default handler when creating a file bookmark.
This is ignored if a handler can be found using option
`bmkp-default-handlers-for-file-types'. Otherwise, this is used by
function `bmkp-default-handler-for-file' to determine the default
handler for a given file."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-temporary-bookmarking-mode-lighter " Temp-Bmk"
"*Lighter for `bmkp-temporary-bookmarking-mode'.
This string shows in the mode line when `bmkp-temporary-bookmarking-mode'
is enabled. Set this to nil or \"\" if you do not want any lighter."
:type 'string :group 'bookmark-plus)
(defcustom bmkp-use-region t
"*Non-nil means visiting a bookmark activates its recorded region."
:type '(choice
(const :tag "Activate bookmark region (except during cycling)" t)
(const :tag "Do not activate bookmark region" nil)
(const :tag "Activate bookmark region even during cycling" cycling-too))
:group 'bookmark-plus)
(defcustom bmkp-w3m-allow-multi-tabs t
"*Non-nil means jump to W3M bookmarks in a new session."
:type 'boolean :group 'bookmark-plus)
(defcustom bmkp-write-bookmark-file-hook ()
"*List of functions called, in order, after writing a bookmark file.
Each function should accept the bookmark file name as first argument.
Used after `after-save-hook'."
:type 'hook :group 'bookmark-plus)
(defconst bmkp-non-file-filename " - no file -"
"Name to use for `filename' entry, for non-file bookmarks.")
(defconst bmkp-types-alist '(("autofile" . bmkp-autofile-history)
("autonamed" . bmkp-autonamed-history)
("bookmark-file" . bmkp-bookmark-file-history)
("bookmark-list" . bmkp-bookmark-list-history)
("desktop" . bmkp-desktop-history)
("dired" . bmkp-dired-history)
("dired-this-dir" . bmkp-dired-history)
("file" . bmkp-file-history)
("file-this-dir" . bmkp-file-history)
("gnus" . bmkp-gnus-history)
("image" . bmkp-image-history)
("info" . bmkp-info-history)
("local-file" . bmkp-local-file-history)
("man" . bmkp-man-history)
("non-file" . bmkp-non-file-history)
("region" . bmkp-region-history)
("remote-file" . bmkp-remote-file-history)
("specific-buffers" . bmkp-specific-buffers-history)
("specific-files" . bmkp-specific-files-history)
("temporary" . bmkp-temporary-history)
("url" . bmkp-url-history)
("variable-list" . bmkp-variable-list-history))
"Alist of bookmark types used by `bmkp-jump-to-type'.
Keys are bookmark type names. Values are corresponding history variables.")
(defvar bmkp-autofile-history () "History for autofile bookmarks.")
(defvar bmkp-autonamed-history () "History for autonamed bookmarks.")
(defvar bmkp-bookmark-file-history () "History for bookmark-file bookmarks.")
(defvar bmkp-bookmark-list-history () "History for bookmark-list bookmarks.")
(defvar bmkp-desktop-history () "History for desktop bookmarks.")
(defvar bmkp-dired-history () "History for Dired bookmarks.")
(defvar bmkp-file-history () "History for file bookmarks.")
(defvar bmkp-gnus-history () "History for Gnus bookmarks.")
(defvar bmkp-image-history () "History for image-file bookmarks.")
(defvar bmkp-info-history () "History for Info bookmarks.")
(defvar bmkp-last-bmenu-state-file nil "Last value of option `bmkp-bmenu-state-file'.")
(defvar bmkp-local-file-history () "History for local-file bookmarks.")
(defvar bmkp-man-history () "History for `man'-page bookmarks.")
(defvar bmkp-non-file-history () "History for buffer (non-file) bookmarks.")
(defvar bmkp-region-history () "History for bookmarks that activate the region.")
(defvar bmkp-remote-file-history () "History for remote-file bookmarks.")
(defvar bmkp-specific-buffers-history () "History for specific-buffers bookmarks.")
(defvar bmkp-specific-files-history () "History for specific-files bookmarks.")
(defvar bmkp-temporary-history () "History for temporary bookmarks.")
(defvar bmkp-url-history () "History for URL bookmarks.")
(defvar bmkp-variable-list-history () "History for variable-list bookmarks.")
(defvar bmkp-w3m-history () "History for W3M bookmarks.")
(defvar bmkp-after-set-hook nil "Hook run after `bookmark-set' sets a bookmark.")
(defvar bmkp-auto-idle-bookmarks ()
"Alist of bookmarks that were created automatically during this session.")
(defvar bmkp-auto-idle-bookmark-mode-timer nil
"Timer for `bmkp-auto-idle-bookmark-mode'.
This variable is buffer-local, which means that there is a separate
timer for each buffer where automatic bookmarking is enabled.
NOTE: For Emacs 20, the variable is not buffer-local, by default. To
make it so, do this:
(make-variable-buffer-local 'bmkp-auto-idle-bookmark-mode-timer)")
(unless (< emacs-major-version 21) (make-variable-buffer-local 'bmkp-auto-idle-bookmark-mode-timer))
(defvar bmkp-autotemp-all-when-set-p nil "Non-nil means make any bookmark temporary whenever it is set.")
(defvar bmkp-copied-tags ()
"List of tags copied from a bookmark, for pasting to other bookmarks.")
(defvar bmkp-current-bookmark-file bookmark-default-file
"Current bookmark file.
When you start Emacs, this is initialized according to
`bmkp-last-as-first-bookmark-file'.
When you load bookmarks using `\\[bmkp-switch-bookmark-file-create]', this is set to the file you
load. When you save bookmarks using `bookmark-save' with no prefix
arg, they are saved to this file.
Loading a bookmark file does not change the value of
`bookmark-default-file', but it might change the value of
`bmkp-last-as-first-bookmark-file' (which see). The value of
`bookmark-default-file' is never changed, except by your
customizations.")
(defvar bmkp-edit-bookmark-orig-record nil
"Record of bookmark being edited.")
(defvar bmkp-file-bookmark-handlers '(bmkp-jump-dired image-bookmark-jump)
"List of functions that handle file or directory bookmarks.
This is used to determine `bmkp-file-bookmark-p'.")
(defvar bmkp-last-bookmark-file bookmark-default-file
"Last bookmark file used in this session (or default bookmark file).
This is a backup for `bmkp-current-bookmark-file'.")
(defvar bmkp-current-nav-bookmark nil "Current bookmark for navigation.")
(defvar bmkp-jump-display-function nil "Function used currently to display a bookmark.")
(defvar bmkp-last-specific-buffer ""
"Name of buffer used by `bmkp-last-specific-buffer-p'.")
(defvar bmkp-last-specific-file ""
"(Absolute) file name used by `bmkp-last-specific-file-p'.")
(defvar bmkp-modified-bookmarks ()
"Alist of bookmarks that have been modified and not saved.")
(defvar bmkp-nav-alist () "Current bookmark alist used for navigation.")
(defvar bmkp-return-buffer nil "Name of buffer to return to.")
(defvar bmkp-reverse-sort-p nil "Non-nil means the sort direction is reversed.")
(defvar bmkp-reverse-multi-sort-p nil
"Non-nil means the truth values returned by predicates are complemented.
This changes the order of the sorting groups, but it does not in
general reverse that order. The order within each group is unchanged
\(not reversed).")
(defvar bmkp-use-w32-browser-p nil
"Non-nil means use `w32-browser' in the default bookmark handler.
That is, use the default Windows application for the bookmarked file.
This has no effect if function `w32-browser' is not defined.")
(defvar bmkp-latest-bookmark-alist () "Copy of `bookmark-alist' as last filtered.")
(defvar bmkp-last-save-flag-value nil "Last value of option `bookmark-save-flag'.")
(defvar bmkp-sorted-alist ()
"Copy of current bookmark alist, as sorted for buffer `*Bookmark List*'.
Has the same structure as `bookmark-alist'.")
(defvar bmkp-tag-history () "History of tags read from the user.")
(defvar bmkp-tags-alist ()
"Alist of all bookmark tags, per option `bmkp-tags-for-completion'.
Each entry is a full tag: a cons whose car is a tag name, a string.
This is set by function `bmkp-tags-list'.
Use that function to update the value.")
(defvar bookmarks-already-loaded nil
"Non-nil means some bookmarks have been loaded during this Emacs session.")
(put 'bookmark-alist 'variable-documentation
"Association list of bookmarks and their records.
Bookmark functions update the value automatically.
You probably do not want to change the value yourself.
The value is an alist with entries of the form
(BOOKMARK-NAME . PARAM-ALIST)
or the deprecated form (BOOKMARK-NAME PARAM-ALIST).
BOOKMARK-NAME is the name you gave to the bookmark when creating it.
PARAM-ALIST is an alist of bookmark information. The order of the
entries in PARAM-ALIST is not important. The possible entries are
described below. An entry with a key but null value means the entry
is not used.
Bookmarks created using vanilla Emacs (`bookmark.el'):
(filename . FILENAME)
(location . LOCATION)
(position . POS)
(front-context-string . STR-AFTER-POS)
(rear-context-string . STR-BEFORE-POS)
(handler . HANDLER)
(annotation . ANNOTATION)
FILENAME names the bookmarked file.
LOCATION names the bookmarked file, URL, or other place (Emacs 23+).
FILENAME or LOCATION is what is shown in the bookmark list
(`C-x r l') when you use `M-t'.
POS is the bookmarked buffer position (position in the file).
STR-AFTER-POS is buffer text that immediately follows POS.
STR-BEFORE-POS is buffer text that immediately precedes POS.
ANNOTATION is a string that you can provide to identify the bookmark.
See options `bookmark-use-annotations' and
`bookmark-automatically-show-annotations'.
HANDLER is a function that provides the bookmark-jump behavior
for a specific kind of bookmark. This is the case for Info
bookmarks, for instance (starting with Emacs 23).
Bookmarks created using Bookmark+ are the same as for vanilla Emacs,
except for the following differences.
1. Visit information is recorded, using entries `visits' and `time':
(visits . NUMBER-OF-VISITS)
(time . TIME-LAST-VISITED)
NUMBER-OF-VISITS is a whole-number counter.
TIME-LAST-VISITED is an Emacs time representation, such as is
returned by function `current-time'.
2. The buffer name is recorded, using entry `buffer-name'. It need
not be associated with a file.
3. If no file is associated with the bookmark, then FILENAME is
` - no file -'.
4. Bookmarks can be tagged by users. The tag information is recorded
using entry `tags':
(tags . TAGS-ALIST)
TAGS-ALIST is an alist with string keys.
5. A bookmark can be simply a wrapper for a file, in which case it has
entry `file-handler' instead of `handler'. When you \"jump\" to such
a bookmark, the `file-handler' function or shell-command is applied to
the `filename' entry. Any `handler' entry present is ignored, as are
entries such as `position'. It is only the target file that is
important.
6. Bookmarks can have individual highlighting, provided by users.
This overrides any default highlighting.
(lighting . HIGHLIGHTING)
HIGHLIGHTING is a property list that contain any of these keyword
pairs:
`:style' - Highlighting style. Cdrs of `bmkp-light-styles-alist'
entries are the possible values.
`:face' - Highlighting face, a symbol.
`:when' - A sexp to be evaluated. Return value of `:no-light'
means do not highlight.
7. The following additional entries are used to record region
information. When a region is bookmarked, POS represents the region
start position.
(end-position . END-POS)
(front-context-region-string . STR-BEFORE-END-POS)
(rear-context-region-string . STR-AFTER-END-POS))
END-POS is the region end position.
STR-BEFORE-END-POS is buffer text that precedes END-POS.
STR-AFTER-END-POS is buffer text that follows END-POS.
The two context region strings are non-nil only when a region is
bookmarked.
NOTE: The relative locations of `front-context-region-string' and
`rear-context-region-string' are reversed from those of
`front-context-string' and `rear-context-string'. For example,
`front-context-string' is the text that *follows* `position', but
`front-context-region-string' *precedes* `end-position'.
8. The following additional entries are used for a Dired bookmark.
(dired-marked . MARKED-FILES)
(dired-switches . SWITCHES)
MARKED-FILES is the list of files that were marked `*'.
SWITCHES is the string of `dired-listing-switches'.
9. The following additional entries are used for a Gnus bookmark.
(group . GNUS-GROUP-NAME)
(article . GNUS-ARTICLE-NUMBER)
(message-id . GNUS-MESSAGE-ID)
GNUS-GROUP-NAME is the name of a Gnus group.
GNUS-ARTICLE-NUMBER is the number of a Gnus article.
GNUS-MESSAGE-ID is the identifier of a Gnus message.
10. For a URL bookmark, FILENAME or LOCATION is a URL.
11. A sequence bookmark has this additional entry:
(sequence . COMPONENT-BOOKMARKS)
COMPONENT-BOOKMARKS is the list of component bookmark names.
12. A function bookmark has this additional entry, which records the
FUNCTION:
(function . FUNCTION)
13. A bookmark-list bookmark has this additional entry, which records
the state of buffer `*Bookmark List*' at the time it is created:
(bookmark-list . STATE)
STATE records the sort order, filter function, omit list, and title.")
(when (< emacs-major-version 23)
(defun Info-bookmark-make-record ()
"Create a bookmark record for the current Info node (and point).
Implements `bookmark-make-record-function' for Info nodes."
(let* ((file (and (stringp Info-current-file) (file-name-nondirectory Info-current-file)))
(bookmark-name (if file
(concat "(" file ") " Info-current-node)
Info-current-node))
(defaults (delq nil (list bookmark-name file Info-current-node))))
`(,bookmark-name
,@(bookmark-make-record-default 'no-file)
(filename . ,Info-current-file)
(info-node . ,Info-current-node)
(handler . Info-bookmark-jump)
(defaults . ,defaults))))
(defun Info-bookmark-jump (bookmark)
"Jump to Info bookmark BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(require 'info)
(let* ((file (bookmark-prop-get bookmark 'filename))
(info-node (bookmark-prop-get bookmark 'info-node))
(buf (save-window-excursion
(Info-find-node file info-node) (current-buffer))))
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bmkp-bookmark-data-from-record bookmark)))))
(add-hook 'Info-mode-hook (lambda () (set (make-local-variable 'bookmark-make-record-function)
'Info-bookmark-make-record)))
(defvar bookmark-make-record-function 'bookmark-make-record-default
"Function called with no arguments, to create a bookmark record.
It should return the new record, which should be a cons cell of the
form (NAME . ALIST) or just ALIST, where ALIST is as described in
`bookmark-alist'. If it cannot construct the record, then it should
raise an error.
NAME is a string that names the new bookmark. NAME can be nil, in
which case a default name is used.
ALIST can contain an entry (handler . FUNCTION) which sets the handler
to FUNCTION, which is then used instead of `bookmark-default-handler'.
FUNCTION must accept the same arguments as `bookmark-default-handler'.
You can set this variable buffer-locally to enable bookmarking of
locations that should be treated specially, such as Info nodes, news
posts, images, pdf documents, etc.")
(defun bookmark-prop-get (bookmark prop)
"Return property PROP of BOOKMARK, or nil if no such property.
BOOKMARK is a bookmark name or a bookmark record."
(cdr (assq prop (bmkp-bookmark-data-from-record bookmark))))
(defun bookmark-get-handler (bookmark)
"Return the `handler' entry for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(bookmark-prop-get bookmark 'handler))
(defun bookmark-jump-noselect (bookmark)
"Return the location recorded for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
The return value has the form (BUFFER . POINT), where BUFFER is a
buffer and POINT is the location within BUFFER."
(save-excursion (bookmark-handle-bookmark bookmark) (cons (current-buffer) (point)))))
(when (< emacs-major-version 22)
(defun bmkp-menu-jump-other-window (event)
"Jump to BOOKMARK (a point in some file) in another window.
See `bookmark-jump-other-window'."
(interactive "e")
(bookmark-popup-menu-and-apply-function 'bookmark-jump-other-window
"Jump to Bookmark (Other Window)" event)))
(defcustom bookmark-version-control t
"Whether to make numbered backups of your bookmarking files.
This includes bookmark files such as `bookmark-default-file' and also
Bookmark+ files `bmkp-bmenu-commands-file' and
`bmkp-bmenu-state-file'.
The option can have value `nospecial', `t', `nil', or `never' . Value
`nospecial' means to use the `version-control' value. The others have
the same meanings as for option `version-control'.
Use value `t' if your bookmarks are important to you. Consider also
using numeric backups. See also nodes `Backup Names' and `Backup
Deletion' in the Emacs manual."
:type '(choice :tag "When to make numbered backups"
(const :tag "Use value of option `version-control'" nospecial)
(const :tag "Never" never)
(const :tag "If existing already" nil)
(other :tag "Always" t))
:group 'bookmark :group 'bookmark-plus)
(defun bookmark-get-bookmark-record (bookmark)
"Return the data part of BOOKMARK, that is, all but the name.
BOOKMARK is a bookmark name or a bookmark record.
If it is a bookmark name then it is looked up in `bookmark-alist'.
If it is a record then it is NOT looked up (need not belong)."
(let ((data (cdr (bookmark-get-bookmark bookmark))))
(if (and (null (cdr data)) (consp (caar data)))
(car data)
data)))
(defun bookmark-get-bookmark (bookmark &optional noerror)
"Return the full bookmark (record) that corresponds to BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
Non-nil optional arg NOERROR means return nil if BOOKMARK is not a
valid bookmark. If NOERROR is nil then raise an error in this case.
If BOOKMARK is a bookmark name instead of a full bookmark then return
what `bmkp-bookmark-record-from-name' (with no MEMP check) returns.
This function is like `bmkp-get-bookmark-in-alist', except that
`bmkp-get-bookmark-in-alist' always tests whether BOOKMARK is in
`bookmark-alist', regardless of whether BOOKMARK is a string (a
bookmark name) or a full bookmark. `bmkp-get-bookmark-in-alist' is
thus a real test for bookmark existence. Use `bookmark-get-bookmark'
only when you do NOT want to look up the bookmark in
`bookmark-alist'."
(cond ((and (consp bookmark) (stringp (car bookmark))) bookmark)
((stringp bookmark) (bmkp-bookmark-record-from-name bookmark noerror))
(t (and (not noerror) (error "Invalid bookmark: `%s'" bookmark)))))
(defun bookmark-make-record ()
"Return a new bookmark record (NAME . ALIST) for the current location.
Start with `bookmark-make-record-function'. If it does not provide a
bookmark name, then use option `bmkp-new-bookmark-default-names' to
provide it. If that does not provide it then use
`bookmark-current-bookmark' or `bookmark-buffer-name', in that order."
(let ((record (funcall bookmark-make-record-function))
defname)
(if (stringp (car record))
record
(when (car record) (push nil record))
(setq defname (catch 'bookmark-make-record
(dolist (fn bmkp-new-bookmark-default-names)
(when (functionp fn)
(let ((val (funcall fn)))
(when (and (stringp val) (not (string= "" val)))
(throw 'bookmark-make-record val)))))
(or bookmark-current-bookmark (bookmark-buffer-name))))
(when (and defname (not (stringp defname))) (setq defname (format "%s" defname)))
(when (string= "" defname) (setq defname "<EMPTY NAME>"))
(setcar record defname)
record)))
(defun bookmark-store (bookmark-name data no-overwrite &optional no-update-p no-msg-p)
"Store the bookmark named BOOKMARK-NAME, giving it DATA.
Return the new bookmark.
DATA is the bookmark record without its name, i.e., what
`bmkp-bookmark-data-from-record' returns.
If NO-OVERWRITE is non-nil and bookmark BOOKMARK-NAME already exists
in the current bookmark list (`bookmark-alist') then record the new
bookmark but do not discard the old one. The check for existence uses
`bmkp-get-bookmark-in-alist'.
Non-nil optional arg NO-UPDATE-P means do not refresh/rebuild the
bookmark-list display.
Non-nil optional arg NO-MSG-P means do not show progress messages.
Note: In spite of the function name, like all functions that define or
change bookmarks, this function does not necessarily save your
bookmark file. Saving the file depends on `bookmark-save-flag'."
(bookmark-maybe-load-default-file)
(let ((bname (copy-sequence bookmark-name))
bmk)
(unless (featurep 'xemacs)
(set-text-properties 0 (length bname) () bname))
(if (or no-overwrite (not (setq bmk (bmkp-get-bookmark-in-alist bname 'NOERROR))))
(push (setq bmk (cons bname data)) bookmark-alist)
(bookmark-set-name bmk bname)
(setcdr bmk data))
(put-text-property 0 (length bname) 'bmkp-full-record bmk bname)
(bmkp-maybe-save-bookmarks)
(unless (memq bmk bmkp-modified-bookmarks)
(setq bmkp-modified-bookmarks (cons bmk bmkp-modified-bookmarks)))
(when (and (boundp 'bmkp-setting-auto-idle-bmk-p)
(not (memq bmk bmkp-auto-idle-bookmarks)))
(setq bmkp-auto-idle-bookmarks (cons bmk bmkp-auto-idle-bookmarks)))
(setq bookmark-current-bookmark bname)
(unless no-update-p (bmkp-refresh/rebuild-menu-list bmk no-msg-p))
bmk))
(defun bookmark-edit-annotation-mode (bookmark)
"Mode for editing the annotation of bookmark BOOKMARK.
When you have finished composing, type \\[bookmark-send-annotation].
BOOKMARK is a bookmark name or a bookmark record.
\\{bookmark-edit-annotation-mode-map}"
(interactive (list (bookmark-completing-read "Edit annotation of bookmark"
(bmkp-default-bookmark-name)
(bmkp-annotated-alist-only))))
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-name)
(setq bookmark-annotation-name bookmark)
(use-local-map bookmark-edit-annotation-mode-map)
(setq major-mode 'bookmark-edit-annotation-mode
mode-name "Edit Bookmark Annotation")
(insert (funcall (if (boundp 'bookmark-edit-annotation-text-func)
bookmark-edit-annotation-text-func
bookmark-read-annotation-text-func)
bookmark))
(let ((annotation (bookmark-get-annotation bookmark)))
(if (and annotation (not (string-equal annotation "")))
(insert annotation)))
(if (fboundp 'run-mode-hooks)
(run-mode-hooks 'text-mode-hook)
(run-hooks 'text-mode-hook)))
(defun bookmark-send-edited-annotation ()
"Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
(interactive)
(unless (eq major-mode 'bookmark-edit-annotation-mode)
(error "Not in bookmark-edit-annotation-mode"))
(goto-char (point-min))
(while (< (point) (point-max))
(if (looking-at "^#")
(bookmark-kill-line t)
(forward-line 1)))
(let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
(bookmark bookmark-annotation-name)
(annotation-buf (current-buffer)))
(when (string= annotation "") (setq annotation nil))
(bookmark-set-annotation bookmark annotation)
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))
(bmkp-refresh/rebuild-menu-list bookmark)
(if (fboundp 'kill-buffer-and-its-windows)
(kill-buffer-and-its-windows annotation-buf)
(kill-buffer annotation-buf))))
(defun bookmark-edit-annotation (bookmark)
"Pop up a buffer for editing bookmark BOOKMARK's annotation.
BOOKMARK is a bookmark name or a bookmark record."
(interactive (list (bookmark-completing-read "Edit annotation of bookmark"
(bmkp-default-bookmark-name)
(bmkp-annotated-alist-only))))
(pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
(bookmark-edit-annotation-mode bookmark))
(defun bookmark-all-names (&optional alist)
"Return a list of all bookmark names.
The names are those of the bookmarks in ALIST or, if nil,
`bookmark-alist'."
(bookmark-maybe-load-default-file)
(mapcar (lambda (bmk) (bmkp-bookmark-name-from-record bmk)) (or alist bookmark-alist)))
(defun bookmark-completing-read (prompt &optional default alist pred hist)
"Read a bookmark name, prompting with PROMPT.
PROMPT is automatically suffixed with \": \", so do not include that.
DEFAULT is a string or a list of strings. If the user input is empty
then return the string (or the first string in the list). If DEFAULT
is nil (absent) then return \"\" for empty input.
The alist argument used for completion is ALIST or, if nil,
`bookmark-alist'.
Optional arg PRED is a predicate used for completion.
Optional arg HIST is a history variable for completion. Default is
`bookmark-history'.
If you access this function from a menu, then, depending on the value
of option `bmkp-menu-popup-max-length' and the number of
bookmarks in ALIST, you choose the bookmark using a menu or using
completion.
If you use Icicles, then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate."
(bmkp-completing-read-1 prompt default alist pred hist nil))
(defun bookmark-make-record-default (&optional no-file no-context position visits)
"Return the record describing the location of a new bookmark.
Point must be where the bookmark is to be set.
Non-nil NO-FILE means return only the subset of the record that
pertains to the location within the buffer (not also the file name).
Non-nil NO-CONTEXT means do not include the front and rear context
strings in the record enough.
Non-nil POSITION means record it, not point, as the `position' entry.
Non-nil VISITS means record it as the `visits' entry."
(let* ((dired-p (and (boundp 'dired-buffers) (car (rassq (current-buffer) dired-buffers))))
(buf (buffer-name))
(ctime (current-time))
(regionp (and transient-mark-mode mark-active (not (eq (mark) (point)))))
(beg (if regionp (region-beginning) (or position (point))))
(end (if regionp (region-end) (point)))
(fcs (if regionp
(bmkp-position-post-context-region beg end)
(bmkp-position-post-context beg)))
(rcs (if regionp
(bmkp-position-pre-context-region beg)
(bmkp-position-pre-context beg)))
(fcrs (when regionp (bmkp-end-position-pre-context beg end)))
(ecrs (when regionp (bmkp-end-position-post-context end))))
`(,@(unless no-file
`((filename . ,(cond ((buffer-file-name) (bookmark-buffer-file-name))
(dired-p nil)
(t bmkp-non-file-filename)))))
(buffer-name . ,buf)
,@(unless (and no-context (> emacs-major-version 23))
`((front-context-string . ,fcs)))
,@(unless (and no-context (> emacs-major-version 23))
`((rear-context-string . ,rcs)))
,@(unless (and no-context (> emacs-major-version 23))
`((front-context-region-string . ,fcrs)))
,@(unless (and no-context (> emacs-major-version 23))
`((rear-context-region-string . ,ecrs)))
(visits . ,(or visits 0))
(time . ,ctime)
(created . ,ctime)
(position . ,beg)
(end-position . ,end))))
(defun bookmark-alist-from-buffer ()
"Read and return a bookmark list (in any format) from the current buffer.
Put the full bookmark record on the bookmark name (in the record), as
a text property. Point is irrelevant and unaffected."
(let ((bmks (save-excursion
(goto-char (point-min))
(if (search-forward bookmark-end-of-version-stamp-marker nil t)
(condition-case err
(read (current-buffer))
(error (error "Cannot read definitions in bookmark file: %s"
(error-message-string err))))
(if (search-forward "(" nil t)
(progn (forward-char -1)
(condition-case err
(read (current-buffer))
(error (error "Cannot read definitions in bookmark file: %s"
(error-message-string err)))))
(error "Buffer is not in bookmark-list format"))))))
(dolist (bmk bmks)
(put-text-property 0 (length (car bmk)) 'bmkp-full-record bmk (car bmk)))
bmks))
(defun bookmark-set (&optional name parg interactivep)
"Set a bookmark named NAME, then run `bmkp-after-set-hook'.
If the region is active (`transient-mark-mode') and nonempty, then
record the region limits in the bookmark.
If NAME is nil, then prompt for the bookmark name. The default names
for prompting are as follows (in order of priority):
* If in W3M mode, then the current W3M title.
* If in a Gnus mode, then the Gnus summary article header.
* If on a `man' page, then the page name (command and section).
* If the region is active and nonempty, then the buffer name followed
by \": \" and the region prefix (up to
`bmkp-bookmark-name-length-max' chars).
* The names defined by option `bmkp-new-bookmark-default-names'.
* The value of variable `bookmark-current-bookmark', the name of the
last-used bookmark for the current file.
* The value returned by function `bookmark-buffer-name'.
For Emacs 23+, all of the names described above are available as
default values, by repeating `M-n'. For older Emacs versions, the
first name provided is the only default value.
While entering a bookmark name at the prompt:
* You can use (lax) completion against bookmarks in the same buffer.
If there are no bookmarks in the current buffer, then all bookmarks
are completion candidates. (See also below, about a numeric prefix
argument.)
* You can use `C-M-w' to yank words from the buffer to the
minibuffer. Repeating `C-M-w' yanks successive words (newlines
between yanked words are stripped out).
* You can use `C-M-u' to insert the name of the last bookmark used in
the buffer. This can be useful as an aid to track your progress
through a large file. (If no bookmark has yet been used, then
`C-M-u' inserts the name of the visited file.)
A prefix argument changes the behavior as follows:
* Numeric prefix arg: Use all bookmarks as completion candidates,
instead of just the bookmarks for the current buffer.
* Plain prefix arg (`C-u'): Do not overwrite a bookmark that has the
same name as NAME, if such a bookmark already exists. Instead,
push the new bookmark onto the bookmark alist.
The most recently set bookmark named NAME is thus the one in effect
at any given time, but any others named NAME are still available,
should you decide to delete the most recent one.
Use `\\[bookmark-delete]' to remove bookmarks (you give it a name, and it removes
only the first instance of a bookmark with that name from the list of
bookmarks)."
(interactive (list nil current-prefix-arg t))
(unwind-protect
(progn
(bookmark-maybe-load-default-file)
(setq bookmark-current-point (point))
(unless (and bookmark-yank-point bookmark-current-buffer)
(save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point)))
(setq bookmark-current-buffer (current-buffer)))
(let* ((record (bookmark-make-record))
(defname (cond ((eq major-mode 'w3m-mode) w3m-current-title)
((eq major-mode 'gnus-summary-mode) (elt (gnus-summary-article-header) 1))
((memq major-mode '(Man-mode woman-mode))
(buffer-substring (point-min) (save-excursion (goto-char (point-min))
(skip-syntax-forward "^ ")
(point))))
(t nil)))
(defname (and defname (bmkp-replace-regexp-in-string "\n" " " defname)))
(bname (or name (bmkp-completing-read-lax
"Set bookmark"
(bmkp-new-bookmark-default-names defname)
(and (or (not parg) (consp parg))
(bmkp-specific-buffers-alist-only))
nil 'bookmark-history))))
(when (and (string= bname "") defname) (setq bname defname))
(while (string= "" bname)
(message "Enter a NON-EMPTY bookmark name") (sit-for 2)
(setq bname (bmkp-completing-read-lax
"Set bookmark"
(bmkp-new-bookmark-default-names defname)
(and (or (not parg) (consp parg))
(bmkp-specific-buffers-alist-only))
nil 'bookmark-history)))
(bookmark-store bname (cdr record) (consp parg) nil (not interactivep))
(when (and interactivep bmkp-prompt-for-tags-flag)
(bmkp-add-tags bname (bmkp-read-tags-completing) 'NO-UPDATE-P))
(case (and (boundp 'bmkp-auto-light-when-set) bmkp-auto-light-when-set)
(autonamed-bookmark (when (bmkp-autonamed-bookmark-p bname)
(bmkp-light-bookmark bname)))
(non-autonamed-bookmark (unless (bmkp-autonamed-bookmark-p bname)
(bmkp-light-bookmark bname)))
(any-bookmark (bmkp-light-bookmark bname))
(autonamed-in-buffer (bmkp-light-bookmarks (bmkp-autonamed-this-buffer-alist-only)
nil interactivep))
(non-autonamed-in-buffer (bmkp-light-bookmarks
(bmkp-remove-if #'bmkp-autonamed-this-buffer-bookmark-p
(bmkp-this-buffer-alist-only))
nil interactivep))
(all-in-buffer (bmkp-light-this-buffer nil interactivep)))
(if bmkp-autotemp-all-when-set-p
(bmkp-make-bookmark-temporary bname)
(catch 'bookmark-set
(dolist (pred bmkp-autotemp-bookmark-predicates)
(when (and (functionp pred) (funcall pred bname))
(bmkp-make-bookmark-temporary bname)
(throw 'bookmark-set t)))))
(run-hooks 'bmkp-after-set-hook)
(if bookmark-use-annotations
(bookmark-edit-annotation bname)
(goto-char bookmark-current-point))))
(setq bookmark-yank-point nil
bookmark-current-buffer nil)))
(defun bookmark-set-name (bookmark newname)
"Set name of BOOKMARK to NEWNAME.
BOOKMARK is a bookmark name or a bookmark record."
(setq bookmark (bookmark-get-bookmark bookmark))
(setcar bookmark newname)
(put-text-property 0 (length newname) 'bmkp-full-record bookmark newname)
(unless (memq bookmark bmkp-modified-bookmarks)
(setq bmkp-modified-bookmarks (cons bookmark bmkp-modified-bookmarks))))
(defun bookmark-yank-word ()
"Yank the word at point in `bookmark-current-buffer'.
Repeat to yank consecutive words from the current buffer, appending
them to the minibuffer. However, newline characters between yanked
words are stripped out."
(interactive)
(let ((string (with-current-buffer bookmark-current-buffer
(goto-char bookmark-yank-point)
(buffer-substring-no-properties (point)
(progn (forward-word 1)
(setq bookmark-yank-point (point)))))))
(setq string (bmkp-replace-regexp-in-string "\n" "" string))
(insert string)))
(defun bookmark-maybe-load-default-file ()
"If bookmarks have not yet been loaded, load them.
If `bmkp-last-as-first-bookmark-file' is non-nil, load it.
Otherwise, load `bookmark-default-file'."
(when (and (file-exists-p bookmark-old-default-file) (not (file-exists-p bookmark-default-file)))
(rename-file bookmark-old-default-file bookmark-default-file))
(let ((file-to-load (bmkp-default-bookmark-file)))
(and (not bookmarks-already-loaded)
(null bookmark-alist)
(file-readable-p file-to-load)
(bookmark-load file-to-load t 'nosave)
(setq bookmarks-already-loaded t))))
(defun bookmark--jump-via (bookmark display-function)
"Display BOOKMARK using DISPLAY-FUNCTION.
Then run `bookmark-after-jump-hook' and show annotations for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(bmkp-record-visit bookmark 'BATCHP)
(setq bmkp-jump-display-function display-function)
(catch 'bookmark--jump-via
(bookmark-handle-bookmark bookmark)
(unless (and bmkp-use-w32-browser-p (fboundp 'w32-browser) (bookmark-get-filename bookmark))
(let ((win (get-buffer-window (current-buffer) 0)))
(when win (set-window-point win (point))))
(when (and (bmkp-autonamed-bookmark-for-buffer-p bookmark (buffer-name))
(not bmkp-use-w32-browser-p))
(setq bookmark (bmkp-update-autonamed-bookmark bookmark)))
(case (and (boundp 'bmkp-auto-light-when-jump) bmkp-auto-light-when-jump)
(autonamed-bookmark (when (bmkp-autonamed-bookmark-p bookmark)
(bmkp-light-bookmark bookmark nil nil nil 'USE-POINT)))
(non-autonamed-bookmark (unless (bmkp-autonamed-bookmark-p bookmark)
(bmkp-light-bookmark bookmark nil nil nil 'USE-POINT)))
(any-bookmark (bmkp-light-bookmark bookmark nil nil nil 'USE-POINT))
(autonamed-in-buffer (bmkp-light-bookmarks
(bmkp-remove-if-not #'bmkp-autonamed-bookmark-p
(bmkp-this-buffer-alist-only))
nil 'MSG))
(non-autonamed-in-buffer (bmkp-light-bookmarks (bmkp-remove-if #'bmkp-autonamed-bookmark-p
(bmkp-this-buffer-alist-only))
nil 'MSG))
(all-in-buffer (bmkp-light-this-buffer nil 'MSG))))
(let ((orig-buff (current-buffer)))
(run-hooks 'bookmark-after-jump-hook))
(let ((jump-fn (bmkp-get-tag-value bookmark "bmkp-jump")))
(when jump-fn (funcall jump-fn)))
(when bookmark-automatically-show-annotations (bookmark-show-annotation bookmark))))
(defun bookmark-prop-set (bookmark prop val)
"Set the property PROP of BOOKMARK to VAL.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let* ((bmk (bookmark-get-bookmark bookmark))
(cell (assq prop (bmkp-bookmark-data-from-record bmk))))
(if cell
(setcdr cell val)
(if (consp (car (cadr bmk)))
(setcdr bmk (list (cons (cons prop val) (cadr bmk))))
(setcdr bmk (cons (cons prop val) (cdr bmk)))))
(unless (memq bmk bmkp-modified-bookmarks)
(setq bmkp-modified-bookmarks (cons bmk bmkp-modified-bookmarks)))))
(defun bookmark-jump (bookmark
&optional display-function use-region-p)
"Jump to bookmark BOOKMARK.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See function `bookmark-load' for more about this.
If the file pointed to by BOOKMARK no longer exists, you are asked if
you wish to give the bookmark a new location. If so, `bookmark-jump'
jumps to the new location and saves it.
If the bookmark defines a region, then the region is activated if
`bmkp-use-region' is not-nil or it is nil and you use a prefix
argument. A prefix arg temporarily flips the value of
`bmkp-use-region'.
If you use Icicles, then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate.
In Lisp code:
BOOKMARK is a bookmark name or a bookmark record.
Non-nil DISPLAY-FUNCTION is a function to display the bookmark. By
default, `switch-to-buffer' is used.
Non-nil USE-REGION-P flips the value of `bmkp-use-region'."
(interactive (list (bookmark-completing-read "Jump to bookmark" (bmkp-default-bookmark-name))
nil
current-prefix-arg))
(bmkp-jump-1 bookmark (or display-function 'switch-to-buffer) use-region-p))
(defun bookmark-jump-other-window (bookmark &optional use-region-p)
"Jump to bookmark BOOKMARK in another window.
See `bookmark-jump', in particular for info about using a prefix arg."
(interactive (list (bookmark-completing-read "Jump to bookmark (in another window)"
(bmkp-default-bookmark-name))
current-prefix-arg))
(bmkp-jump-1 bookmark 'bmkp-select-buffer-other-window use-region-p))
(defun bookmark-handle-bookmark (bookmark)
"Call BOOKMARK's handler, or `bookmark-default-handler' if it has none.
Return nil or raise an error.
BOOKMARK is a bookmark name or a bookmark record.
More precisely:
If `bmkp-use-w32-browser-p' is non-`nil' and `w32-browser' is
defined then invoke the MS Windows `Open' action.
Else, if BOOKMARK has both `file-handler' and `filename' entries
then apply the former to the latter.
Else, if BOOKMARK has a `handler' property that is a defined
function then apply it to BOOKMARK.
Else, apply the default bookmark handler,
`bookmark-default-handler', to BOOKMARK.
The default handler changes the current buffer and point.
If the default handler is used and a file error is raised, the error
is handled as follows:
If BOOKMARK has no `filename' entry, do nothing.
Else prompt to relocate the file.
If relocated, then try again to handle. Else raise a file error."
(cond ((and bmkp-use-w32-browser-p (fboundp 'w32-browser) (bookmark-get-filename bookmark))
(w32-browser (bookmark-get-filename bookmark))
(condition-case nil (throw 'bookmark--jump-via 'BOOKMARK-HANDLE-BOOKMARK) (no-catch nil)))
((functionp (bookmark-prop-get bookmark 'file-handler))
(funcall (bookmark-prop-get bookmark 'file-handler) (bookmark-get-filename bookmark)))
((functionp (bookmark-get-handler bookmark))
(funcall (bookmark-get-handler bookmark) (bookmark-get-bookmark bookmark)))
(t
(condition-case err
(funcall 'bookmark-default-handler (bookmark-get-bookmark bookmark))
(bookmark-error-no-filename
(when (stringp bookmark)
(let ((file (bookmark-get-filename bookmark))
(use-dialog-box nil)
(use-file-dialog nil))
(when file
(unless (string= file bmkp-non-file-filename) (setq file (expand-file-name file)))
(ding)
(cond ((y-or-n-p (if (and (string= file bmkp-non-file-filename)
(bmkp-get-buffer-name bookmark))
"Bookmark's buffer does not exist. Re-create it? "
(concat (file-name-nondirectory file) " nonexistent. Relocate \""
bookmark "\"? ")))
(if (string= file bmkp-non-file-filename)
(pop-to-buffer (bmkp-get-buffer-name bookmark))
(bookmark-relocate bookmark))
(funcall (or (bookmark-get-handler bookmark) 'bookmark-default-handler)
(bookmark-get-bookmark bookmark)))
(t
(message "Bookmark not relocated: `%s'" bookmark)
(signal (car err) (cdr err)))))))))))
(when (stringp bookmark) (setq bookmark-current-bookmark bookmark))
nil)
(put 'bookmark-error-no-filename 'error-conditions
'(error bookmark-errors bookmark-error-no-filename))
(put 'bookmark-error-no-filename 'error-message "Bookmark has no associated file (or directory)")
(defun bookmark-default-handler (bookmark)
"Default handler to jump to the location of BOOKMARK.
Return nil (or raise an error).
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'.
If `bmkp-use-w32-browser-p' is non-nil and function `w32-browser' is
defined, then call `w32-browser'. That is, use the default MS Windows
application for the bookmarked file.
If BOOKMARK has properties `file-handler' and `filename', then apply
the value of the former to the latter.
If BOOKMARK is an old-style Info bookmark, then go to the Info node.
If BOOKMARK records a nonempty region and `bmkp-use-region' is
non-nil then activate the region.
Otherwise, call `bmkp-goto-position' to go to the recorded position."
(let* ((bmk (bookmark-get-bookmark bookmark))
(file (bookmark-get-filename bmk))
(buf (bookmark-prop-get bmk 'buffer))
(bufname (bmkp-get-buffer-name bmk))
(pos (bookmark-get-position bmk))
(end-pos (bmkp-get-end-position bmk))
(old-info-node (and (not (bookmark-get-handler bookmark)) (bookmark-prop-get bmk 'info-node))))
(cond ((and bmkp-use-w32-browser-p (fboundp 'w32-browser) file) (w32-browser file))
((and (bookmark-prop-get bookmark 'file-handler) file)
(funcall (bookmark-prop-get bookmark 'file-handler) file))
(old-info-node
(progn (require 'info) (Info-find-node file old-info-node) (goto-char pos)))
((not (and bmkp-use-region end-pos (/= pos end-pos)))
(bmkp-goto-position bmk file buf bufname pos
(bookmark-get-front-context-string bmk)
(bookmark-get-rear-context-string bmk)))
(t
(if (and file (file-readable-p file) (not (buffer-live-p buf)))
(with-current-buffer (find-file-noselect file) (setq buf (buffer-name)))
(unless (or (and buf (get-buffer buf))
(and bufname (get-buffer bufname) (not (string= buf bufname))))
(signal 'bookmark-error-no-filename (list 'stringp file))))
(set-buffer (or buf bufname))
(when bmkp-jump-display-function
(save-current-buffer (funcall bmkp-jump-display-function (current-buffer)))
(raise-frame))
(goto-char (min pos (point-max)))
(when (> pos (point-max)) (error "Bookmark position is beyond buffer end"))
(funcall bmkp-handle-region-function bmk)))
nil))
(defun bookmark-relocate (bookmark-name &optional no-update-p)
"Relocate the bookmark named BOOKMARK-NAME to another file.
You are prompted for the new file name.
Non-nil optional arg NO-UPDATE-P means do not refresh/rebuild the
bookmark-list display.
Changes the file associated with the bookmark.
Useful when a file has been renamed after a bookmark was set in it.
If you use Icicles, then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate."
(interactive (list (bookmark-completing-read "Bookmark to relocate" (bmkp-default-bookmark-name))))
(bookmark-maybe-historicize-string bookmark-name)
(bookmark-maybe-load-default-file)
(let* ((icicle-unpropertize-completion-result-flag t)
(bookmark-filename (bookmark-get-filename bookmark-name))
(new-filename (abbreviate-file-name
(expand-file-name
(read-file-name
(format "Relocate %s to: " bookmark-name)
(file-name-directory bookmark-filename))))))
(bookmark-set-filename bookmark-name new-filename)
(let ((dired-dir (bookmark-prop-get bookmark-name 'dired-directory)))
(when (and dired-dir (equal dired-dir bookmark-filename))
(bookmark-prop-set bookmark-name 'dired-directory new-filename))))
(bmkp-maybe-save-bookmarks)
(when (and bookmark-bmenu-toggle-filenames (get-buffer "*Bookmark List*")
(get-buffer-window (get-buffer "*Bookmark List*") 0)
(not no-update-p))
(with-current-buffer (get-buffer "*Bookmark List*")
(bmkp-refresh-menu-list bookmark-name))))
(defun bookmark-insert-location (bookmark-name &optional no-history)
"Insert file or buffer name for the bookmark named BOOKMARK-NAME.
If a file is bookmarked, insert the recorded file name.
If a non-file buffer is bookmarked, insert the recorded buffer name.
Optional arg NO-HISTORY means do not record BOOKMARK-NAME in
`bookmark-history'.
If you use Icicles then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate."
(interactive
(let ((bmk (bookmark-completing-read "Insert bookmark location" (bmkp-default-bookmark-name))))
(if (> emacs-major-version 21) (list bmk) bmk)))
(unless no-history (bookmark-maybe-historicize-string bookmark-name))
(insert (bookmark-location bookmark-name)))
(defun bookmark-location (bookmark)
"Return a description of the location of BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'.
Look first for property `location', then for property `filename', then
for property `buffer-name'. Return the first such property found, or
\"-- Unknown location --\" if none is found."
(bookmark-maybe-load-default-file)
(setq bookmark (bookmark-get-bookmark bookmark))
(or (bookmark-prop-get bookmark 'location)
(bookmark-get-filename bookmark)
(bmkp-get-buffer-name bookmark)
(bookmark-prop-get bookmark 'buffer)
"-- Unknown location --"))
(defun bookmark-rename (old &optional new batchp)
"Change bookmark's name from OLD to NEW.
Interactively:
If called from the keyboard, then prompt for OLD.
If called from the menubar, select OLD from a menu.
If NEW is nil, then prompt for its string value (unless BATCH).
When entering the NEW name you can use completion against existing
bookmark names. This completion is lax, so you can easily edit an
existing name. See `bookmark-set' for particular keys available
during this input.
If BATCHP is non-nil, then do not rebuild the bookmark list. (NEW
should be non-nil if BATCH is non-nil.)
If you use Icicles then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate."
(interactive (list (bookmark-completing-read "Old bookmark name" (bmkp-default-bookmark-name))))
(bookmark-maybe-historicize-string old)
(bookmark-maybe-load-default-file)
(setq bookmark-current-point (point))
(save-excursion (skip-chars-forward " ") (setq bookmark-yank-point (point)))
(setq bookmark-current-buffer (current-buffer))
(let ((newname (or new (and (not batchp) (bmkp-completing-read-lax "New name" old)))))
(when newname
(bookmark-set-name old newname)
(put-text-property 0 (length newname) 'bmkp-full-record (bmkp-bookmark-record-from-name newname)
newname)
(bmkp-rename-for-marked-and-omitted-lists old newname)
(setq bookmark-current-bookmark newname)
(unless batchp
(if (and (get-buffer "*Bookmark List*") (get-buffer-window (get-buffer "*Bookmark List*") 0))
(with-current-buffer (get-buffer "*Bookmark List*")
(bmkp-refresh-menu-list newname))
(bookmark-bmenu-surreptitiously-rebuild-list)))
(bmkp-maybe-save-bookmarks))
(or newname old)))
(or (fboundp 'bmkp-ORIG-bookmark-insert)
(fset 'bmkp-ORIG-bookmark-insert (symbol-function 'bookmark-insert)))
(defun bookmark-insert (bookmark-name)
"Insert the text of a bookmarked file.
BOOKMARK-NAME is the name of the bookmark.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See function `bookmark-load' for more about this.
If you use Icicles, then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate."
(interactive (list (bookmark-completing-read "Insert bookmark contents" (bmkp-default-bookmark-name))))
(bmkp-ORIG-bookmark-insert bookmark-name))
(defun bookmark-delete (bookmark &optional batchp)
"Delete the BOOKMARK from the bookmark list.
BOOKMARK is a bookmark name or a bookmark record.
Interactively, default to the \"current\" bookmark (that is, the one
most recently used in this file), if it exists.
If BOOKMARK is a name and it has property `bmkp-full-record' then use
that property along with the name to find the bookmark to delete.
If it is a name without property `bmkp-full-record' then delete (only)
the first bookmark in `bookmark-alist' with that name.
Optional arg BATCHP means do not update buffer `*Bookmark List*'.
If you use Icicles, then you can use `S-delete' during completion of a
bookmark name to delete the bookmark named by the current completion
candidate. In this way, you can delete multiple bookmarks."
(interactive (list (bookmark-completing-read "Delete bookmark" (bmkp-default-bookmark-name))))
(bookmark-maybe-load-default-file)
(let* ((bmk (bookmark-get-bookmark bookmark 'NOERROR))
(bname (bmkp-bookmark-name-from-record bmk)))
(when bname
(bookmark-maybe-historicize-string bname)
(when (fboundp 'bmkp-unlight-bookmark) (bmkp-unlight-bookmark bmk 'NOERROR))
(setq bookmark-alist (delq bmk bookmark-alist)
bmkp-latest-bookmark-alist (delq bmk bmkp-latest-bookmark-alist)
bmkp-auto-idle-bookmarks (delq bmk bmkp-auto-idle-bookmarks)
bmkp-bmenu-omitted-bookmarks (bmkp-delete-bookmark-name-from-list
bname bmkp-bmenu-omitted-bookmarks))
(unless (bmkp-get-bookmark-in-alist bookmark-current-bookmark 'NOERROR)
(setq bookmark-current-bookmark nil))
(unless batchp (bmkp-refresh/rebuild-menu-list))
(bmkp-maybe-save-bookmarks))))
(defun bookmark-save (&optional parg file)
"Save currently defined bookmarks.
Save by default in the file named by variable
`bmkp-current-bookmark-file'. With a prefix arg, you are prompted for
the file to save to.
If `bmkp-last-as-first-bookmark-file' is non-nil, update its value to
the file being saved.
To load bookmarks from a specific file, use `\\[bookmark-load]'
\(`bookmark-load').
If called from Lisp:
With nil PARG, use file `bmkp-current-bookmark-file'.
With non-nil PARG and non-nil FILE, use file FILE.
With non-nil PARG and nil FILE, prompt the user for the file to use."
(interactive "P")
(bookmark-maybe-load-default-file)
(let ((file-to-save
(cond ((and (not parg) (not file)) bmkp-current-bookmark-file)
((and (not parg) file) file)
((and parg (not file)) (bmkp-read-bookmark-file-name
"File to save bookmarks in: ")))))
(when (and bmkp-last-as-first-bookmark-file
bookmark-save-flag)
(customize-save-variable 'bmkp-last-as-first-bookmark-file file-to-save))
(bookmark-write-file file-to-save))
(setq bookmark-alist-modification-count 0
bmkp-modified-bookmarks ())
(bmkp-refresh/rebuild-menu-list))
(defun bookmark-write-file (file &optional alt-msg)
"Write `bookmark-alist' to FILE.
Bookmarks that have a non-nil `bmkp-temp' property are not saved.
They are removed from the bookmark file, but not from the current
bookmark list.
Non-nil ALT-MSG is a message format string to use in place of the
default, \"Saving bookmarks to file `%s'...\". The string must
contain a `%s' construct, so that it can be passed along with FILE to
`format'. At the end, \"done\" is appended to the message."
(let ((msg (or alt-msg "Saving bookmarks to file `%s'..." file)))
(message (or alt-msg "Saving bookmarks to file `%s'...") file)
(with-current-buffer (find-file-noselect file)
(goto-char (point-min))
(delete-region (point-min) (point-max))
(let ((print-length nil)
(print-level nil)
bname fname last-fname)
(bookmark-insert-file-format-version-stamp)
(insert "(")
(dolist (bmk bookmark-alist)
(unless (bmkp-temporary-bookmark-p bmk)
(setq bname (car bmk)
fname (bookmark-get-filename bmk))
(when (or (not (> emacs-major-version 20))
(not bmkp-propertize-bookmark-names-flag))
(set-text-properties 0 (length bname) () bname)
(when fname (set-text-properties 0 (length fname) () fname)))
(setcar bmk bname)
(when (setq last-fname (assq 'filename bmk)) (setcdr last-fname fname))
(let ((print-circle t))
(if (not (and (or (not (> emacs-major-version 20))
(not bmkp-propertize-bookmark-names-flag))
(bmkp-sequence-bookmark-p bmk)))
(pp bmk (current-buffer))
(insert "(\"" (let ((sname (copy-sequence (car bmk))))
(set-text-properties 0 (length sname) () sname)
sname)
"\"\n")
(dolist (prop (cdr bmk))
(if (not (eq 'sequence (car prop)))
(insert " " (pp-to-string prop))
(insert " (sequence " (mapconcat (lambda (bname)
(let ((name (copy-sequence bname)))
(set-text-properties 0 (length name) () name)
(concat "\"" name "\"")))
(cdr prop) " ")
")\n")))
(insert " )\n")))))
(insert ")")
(let ((version-control (case bookmark-version-control
((nil) nil)
(never 'never)
(nospecial version-control)
(t t)))
(require-final-newline t)
(errorp nil))
(condition-case nil
(write-file file)
(file-error (setq errorp t) (message "CANNOT WRITE FILE `%s'" file) (sit-for 4)))
(kill-buffer (current-buffer))
(run-hook-with-args 'bmkp-write-bookmark-file-hook file)
(unless errorp (message (concat msg "done") file)))))))
(defun bookmark-load (file &optional overwrite batchp)
"Load bookmarks from FILE (which must be in the standard format).
Without a prefix argument (argument OVERWRITE is nil), add the newly
loaded bookmarks to those already current. They will be saved to the
current bookmark file when bookmarks are saved.
If you do not use a prefix argument, then no existing bookmarks are
overwritten. If you load some bookmarks that have the same names as
bookmarks already defined in your Emacs session, numeric suffixes
\"<2>\", \"<3>\",... are appended as needed to the names of those new
bookmarks to distinguish them.
With a prefix argument, switch the bookmark file currently used,
*replacing* all currently existing bookmarks with the newly loaded
bookmarks. In this case, the value of `bmkp-current-bookmark-file'is
backed up to `bmkp-last-bookmark-file' and then changed to FILE, so
bookmarks will subsequently be saved to FILE. If
`bmkp-last-as-first-bookmark-file' is non-nil then its value is also
changed to FILE and it is saved persistently, so that the next Emacs
session will start with it as the bookmark file. (The value of
`bookmark-default-file' is unaffected.)
Interactively, if any bookmarks have been modified since last saved
then you are asked whether you want to first save them before loading
FILE. If you hit `C-g' then both saving and loading are canceled.
When called from Lisp, non-nil optional arg BATCHP means this is not
an interactive call. In this case, do not interact with the user: do
not ask whether to save the current (unsaved) bookmark list before
loading
update/refresh buffer `*Bookmark List*'.
If BATCHP is `save' and bookmarks have been modified since the
bookmark list was last saved, then save the bookmark list before
loading.
If BATCHP is any other non-nil value besides `save', do not save the
bookmark list.
Your initial bookmark file, either `bmkp-last-as-first-bookmark-file'
or `bookmark-default-file', is loaded automatically by Emacs the first
time you use bookmarks in a session - you do not need to load it
manually. Use `bookmark-load' only to load extra bookmarks (with no
prefix arg) or an alternative set of bookmarks (with a prefix arg).
If you use `bookmark-load' to load a file that does not contain a
proper bookmark alist, then when bookmarks are saved the current
bookmark file will likely become corrupted. You should load only
bookmark files that were created using the bookmark functions."
(interactive
(list (let ((default (if (bmkp-same-file-p bmkp-current-bookmark-file bmkp-last-bookmark-file)
(bmkp-default-bookmark-file)
bmkp-last-bookmark-file)))
(bmkp-read-bookmark-file-name
(if current-prefix-arg "Switch to bookmark file: " "Add bookmarks from file: ")
(or (file-name-directory default) "~/")
default
t))
current-prefix-arg))
(when (or (eq batchp 'save)
(and (not batchp) (> bookmark-alist-modification-count 0)
(condition-case err
(yes-or-no-p "Save current bookmarks before loading? (`C-g': cancel load) ")
(quit (error "OK, canceled"))
(error (error (error-message-string err))))))
(bookmark-save))
(setq file (abbreviate-file-name (expand-file-name file)))
(unless (file-readable-p file) (error "Cannot read bookmark file `%s'" file))
(unless batchp (message "Loading bookmarks from `%s'..." file))
(let ((existing-buf (get-file-buffer file)))
(with-current-buffer (let ((enable-local-variables nil)) (find-file-noselect file))
(goto-char (point-min))
(bookmark-maybe-upgrade-file-format)
(let ((blist (bookmark-alist-from-buffer)))
(unless (listp blist) (error "Invalid bookmark list in `%s'" file))
(cond (overwrite
(setq bmkp-last-bookmark-file bmkp-current-bookmark-file
bmkp-current-bookmark-file file
bookmark-alist blist
bookmark-alist-modification-count 0)
(when bmkp-last-as-first-bookmark-file
(customize-save-variable 'bmkp-last-as-first-bookmark-file file)))
(t
(bookmark-import-new-list blist)
(setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count))))
(setq bookmarks-already-loaded t
bmkp-sorted-alist (bmkp-sort-omit bookmark-alist)))
(unless (eq existing-buf (current-buffer)) (kill-buffer (current-buffer)))))
(unless batchp
(bmkp-refresh/rebuild-menu-list)
(message "%s bookmarks in `%s'" (if overwrite "Switched to" "Added") file)))
(defun bookmark-show-annotation (bookmark &optional msg-p)
"Display the annotation for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'.
If no annotation and MSG-P is non-nil, show a no-annotation message."
(let* ((bmk (bookmark-get-bookmark bookmark 'NOERROR))
(bmk-name (bmkp-bookmark-name-from-record bmk))
(ann (and bmk (bookmark-get-annotation bmk))))
(if (not (and ann (not (string-equal ann ""))))
(when msg-p (message "Bookmark has no annotation"))
(let ((oframe (selected-frame)))
(save-selected-window
(pop-to-buffer (get-buffer-create (format "*`%s' Annotation*" bmk-name)))
(let ((buffer-read-only nil))
(delete-region (point-min) (point-max))
(insert (concat "Annotation for bookmark '" bmk-name "':\n\n"))
(put-text-property (line-beginning-position -1) (line-end-position 1)
'face 'bmkp-heading)
(insert ann))
(goto-char (point-min))
(view-mode-enter (cons (selected-window) (cons nil 'quit-window)))
(when (fboundp 'fit-frame-if-one-window) (fit-frame-if-one-window)))
(select-frame-set-input-focus oframe)))))
(defun bookmark-show-all-annotations ()
"Display the annotations for all bookmarks."
(let ((oframe (selected-frame)))
(save-selected-window
(pop-to-buffer (get-buffer-create "*Bookmark Annotations*"))
(let ((buffer-read-only nil))
(delete-region (point-min) (point-max))
(dolist (full-record bookmark-alist)
(let ((ann (bookmark-get-annotation full-record)))
(when (and ann (not (string-equal ann "")))
(insert (concat (bmkp-bookmark-name-from-record full-record) ":\n"))
(put-text-property (line-beginning-position 0) (line-end-position 0) 'face 'bmkp-heading)
(insert ann) (unless (bolp) (insert "\n\n")))))
(goto-char (point-min))
(view-mode-enter (cons (selected-window) (cons nil 'quit-window)))
(when (fboundp 'fit-frame-if-one-window) (fit-frame-if-one-window))))
(select-frame-set-input-focus oframe)))
(defun bookmark-exit-hook-internal ()
"Save currently defined bookmarks and perhaps bookmark menu-list state.
Run `bookmark-exit-hook', then save bookmarks if they were updated.
Then save menu-list state to file `bmkp-bmenu-state-file', but only if
that option is non-nil."
(run-hooks 'bookmark-exit-hook)
(when (bookmark-time-to-save-p t) (bookmark-save))
(bmkp-save-menu-list-state))
(defun bmkp-new-bookmark-default-names (&optional first-def)
"Return a list of default names (strings) for a new bookmark.
A non-nil optional arg FIRST-DEF is prepended to the list of names
described below.
If the region is active and non-empty, then the first default name
\(other than FIRST-DEF) is the current buffer name followed by \": \"
and the region prefix (up to `bmkp-bookmark-name-length-max' chars).
The other names are as described below.
Uses option `bmkp-new-bookmark-default-names' to come up with the
other names. To these names, `bookmark-current-bookmark' and
`bookmark-buffer-name' are appended, if available (non-nil).
NOTE: For Emacs versions prior to Emacs 23, return only a single
default name, not a list of names. The name is the first in the list
of names described above for Emacs 23+."
(let ((defs (and first-def (list first-def)))
val)
(unless (and (< emacs-major-version 23) defs)
(when (and transient-mark-mode mark-active (not (eq (mark) (point))))
(let* ((regname (concat (buffer-name) ": " (buffer-substring (region-beginning) (region-end))))
(defname (bmkp-replace-regexp-in-string
"\n" " "
(progn (save-excursion (goto-char (region-beginning))
(skip-chars-forward " ")
(setq bookmark-yank-point (point)))
(substring regname 0 (min bmkp-bookmark-name-length-max
(length regname)))))))
(if (< emacs-major-version 23)
(setq defs defname)
(add-to-list 'defs defname))))
(unless (and (< emacs-major-version 23) defs)
(catch 'bmkp-new-bookmark-default-names
(dolist (fn bmkp-new-bookmark-default-names)
(when (functionp fn)
(setq val (funcall fn))
(when (and (stringp val) (not (string= "" val)))
(setq val (bmkp-replace-regexp-in-string "\n" " " val))
(if (> emacs-major-version 22)
(add-to-list 'defs val)
(throw 'bmkp-new-bookmark-default-names (setq defs val)))))))
(when (and (< emacs-major-version 23) (null defs))
(setq defs (or bookmark-current-bookmark (bookmark-buffer-name))))
(when (listp defs)
(when bookmark-current-bookmark (push bookmark-current-bookmark defs))
(let ((buf (bookmark-buffer-name))) (when buf (push buf defs)))
(setq defs (nreverse defs)))))
defs))
(defun bmkp-bookmark-record-from-name (bookmark-name &optional noerror memp alist)
"Return the full bookmark (record) that corresponds to BOOKMARK-NAME.
BOOKMARK-NAME must be a string. If it has non-nil text property
`bmkp-full-record' then use that. Otherwise, look for the first
bookmark in ALIST that has the given name.
Non-nil optional arg NOERROR means return nil if BOOKMARK-NAME does
not name a valid bookmark or is valid but is not in ALIST. If NOERROR
is nil then raise an error in this case.
Non-nil optional arg MEMP means that if property `bmkp-full-record' is
available then look up its value (the full bookmark) in ALIST, testing
with `eq'. If that record is not in ALIST, return nil.
Optional arg ALIST defaults to `bookmark-alist'."
(unless alist (setq alist bookmark-alist))
(let ((full (get-text-property 0 'bmkp-full-record bookmark-name)))
(or (and full
(or (not memp) (memq full alist))
full)
(if (fboundp 'assoc-string)
(assoc-string bookmark-name alist bookmark-completion-ignore-case)
(assoc bookmark-name alist))
(and (not noerror) (error "No such bookmark in bookmark list: `%s'" bookmark-name)))))
(defun bmkp-rename-for-marked-and-omitted-lists (old new)
"Replace OLD bookmark name with NEW in marked and omitted lists."
(when (bmkp-marked-bookmark-p old)
(setq bmkp-bmenu-marked-bookmarks (bmkp-delete-bookmark-name-from-list old
bmkp-bmenu-marked-bookmarks))
(push new bmkp-bmenu-marked-bookmarks))
(when (bmkp-omitted-bookmark-p old)
(setq bmkp-bmenu-omitted-bookmarks (bmkp-delete-bookmark-name-from-list old
bmkp-bmenu-omitted-bookmarks))
(push new bmkp-bmenu-omitted-bookmarks)))
(defun bmkp-get-bookmark-in-alist (bookmark &optional noerror alist)
"Return the full bookmark in ALIST that corresponds to BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
Non-nil optional arg NOERROR means return nil if BOOKMARK does not
represent a valid bookmark or is valid but is not in ALIST. If
NOERROR is nil then raise an error in this case.
Optional arg ALIST defaults to `bookmark-alist'.
Bookmark membership in ALIST is tested using `eq'.
If BOOKMARK is a bookmark name instead of a full bookmark then return
what `bmkp-bookmark-record-from-name' with non-nil arg MEMP returns.
This function is like `bookmark-get-bookmark', except that
`bookmark-get-bookmark' tests whether BOOKMARK is in `bookmark-alist'
only when it is a string (a bookmark name, not a full bookmark). When
BOOKMARK is a full bookmark `bookmark-get-bookmark' is thus not a test
for its existence, as is `bmkp-get-bookmark-in-alist'."
(cond ((consp bookmark) (and (memq bookmark bookmark-alist) bookmark))
((stringp bookmark) (bmkp-bookmark-record-from-name bookmark noerror 'MEMP))
(t (and (not noerror) (error "Invalid bookmark: `%s'" bookmark)))))
(defun bmkp-default-bookmark-file ()
"`bmkp-last-as-first-bookmark-file', or `bookmark-default-file' if nil."
(or bmkp-last-as-first-bookmark-file bookmark-default-file))
(defun bmkp-completing-read-bookmarks (&optional alist pred hist names-only-p)
"Read bookmark names and return the bookmarks named as a list.
You are prompted for each bookmark name. Hit `RET' with empty input
to end.
ALIST is the bookmark alist to use. If nil, use `bookmark-alist'.
NAMES-ONLY-P non-nil means return bookmark names, not full bookmarks.
If NAMES-ONLY-P is `lax' then completion is lax."
(let ((bmks ())
(bmk t))
(while bmk
(setq bmk (bmkp-completing-read-1 "Bookmark (RET for each, empty input to finish)"
"" alist pred hist (eq names-only-p 'lax)))
(when (equal "" bmk) (setq bmk nil))
(when (and bmk (not names-only-p)) (setq bmk (bmkp-get-bookmark-in-alist bmk 'NO-ERROR alist)))
(when bmk (push bmk bmks)))
(setq bmks (nreverse bmks))
bmks))
(defun bmkp-completing-read-lax (prompt &optional default alist pred hist)
"Read a bookmark name, prompting with PROMPT.
Like `bookmark-completing-read', but completion is lax: your input
need not match any existing bookmark name.
In addition:
* You can use `SPC' and `?' freely when typing the name.
* You can use `C-M-w' repeatedly to yank consecutive words from the
current buffer (see `bookmark-yank-word')."
(let ((orig-C-M-w (lookup-key minibuffer-local-completion-map (kbd "C-M-w")))
(orig-C-M-u (lookup-key minibuffer-local-completion-map (kbd "C-M-u")))
(orig-SPC (lookup-key minibuffer-local-completion-map (kbd "SPC")))
(orig-qmark (lookup-key minibuffer-local-completion-map (kbd "?"))))
(unwind-protect
(progn (define-key minibuffer-local-completion-map (kbd "C-M-w") 'bookmark-yank-word)
(define-key minibuffer-local-completion-map (kbd "C-M-u") 'bookmark-insert-current-bookmark)
(unless (and (boundp 'icicle-mode) icicle-mode
(eq orig-SPC 'icicle-self-insert))
(define-key minibuffer-local-completion-map (kbd "SPC") 'self-insert-command))
(unless (and (boundp 'icicle-mode) icicle-mode
(eq orig-qmark 'icicle-self-insert))
(define-key minibuffer-local-completion-map (kbd "?") 'self-insert-command))
(bmkp-completing-read-1 prompt default alist pred hist t))
(define-key minibuffer-local-completion-map (kbd "C-M-w") orig-C-M-w)
(define-key minibuffer-local-completion-map (kbd "C-M-u") orig-C-M-u)
(define-key minibuffer-local-completion-map (kbd "SPC") orig-SPC)
(define-key minibuffer-local-completion-map (kbd "?") orig-qmark))))
(defun bmkp-completing-read-1 (prompt default alist pred hist laxp)
"Helper for `bookmark-completing-read' and `bmkp-completing-read-lax'.
LAXP non-nil means use lax (non-strict) completion."
(bookmark-maybe-load-default-file)
(setq alist (or alist bookmark-alist))
(if (and (not laxp)
(listp last-nonmenu-event)
(or (eq t bmkp-menu-popup-max-length)
(and (integerp bmkp-menu-popup-max-length)
(< (length alist) bmkp-menu-popup-max-length))))
(bookmark-menu-popup-paned-menu
t prompt
(if bmkp-sort-comparer
(sort (bookmark-all-names alist) 'string-lessp)
(bookmark-all-names alist)))
(let* ((icicle-delete-candidate-object (lambda (cand)
(bookmark-delete (icicle-transform-multi-completion cand))))
(completion-ignore-case bookmark-completion-ignore-case)
(default (and (not (equal "" default)) default))
(prompt (concat prompt (if default
(format " (%s): " (if (consp default)
(car default)
default))
": ")))
(str (completing-read prompt alist pred (not laxp) nil
(or hist 'bookmark-history) default)))
str)))
(defun bmkp-jump-1 (bookmark display-function use-region-p)
"Helper function for `bookmark-jump' commands.
BOOKMARK is a bookmark name or a bookmark record.
DISPLAY-FUNCTION is passed to `bookmark--jump-via'.
Non-nil USE-REGION-P means activate the region, if recorded."
(setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
(unless bookmark (error "No bookmark specified"))
(bookmark-maybe-historicize-string (bmkp-bookmark-name-from-record bookmark))
(let ((bmkp-use-region (if use-region-p (not bmkp-use-region) bmkp-use-region)))
(bookmark--jump-via bookmark display-function)))
(defun bmkp-select-buffer-other-window (buffer)
"Select BUFFER in another window.
If `bmkp-other-window-pop-to-flag' is non-nil, then use
`pop-to-buffer'. Otherwise, use `switch-to-buffer-other-window'."
(if bmkp-other-window-pop-to-flag
(pop-to-buffer buffer t)
(switch-to-buffer-other-window buffer)))
(defun bmkp-maybe-save-bookmarks (&optional same-count-p)
"Increment save counter and maybe save `bookmark-alist'.
Non-nil optional arg SAME-COUNT-P means do not increment
`bookmark-alist-modification-count'."
(unless same-count-p (setq bookmark-alist-modification-count (1+ bookmark-alist-modification-count)))
(when (bookmark-time-to-save-p) (bookmark-save)))
(defun bmkp-edit-bookmark-name-and-file (bookmark &optional edit-record-p)
"Edit BOOKMARK's name and file name, and maybe save them.
Return a list of the new bookmark name and new file name.
BOOKMARK is a bookmark name or a bookmark record.
Without a prefix arg, you are prompted for the new bookmark name and
the new file name. When entering the new name you can use completion
against existing names. This completion is lax, so you can easily
edit an existing name. See `bookmark-set' for particular keys
available during this input.
With a prefix arg, edit the complete bookmark record (the
internal, Lisp form)."
(interactive
(list (bookmark-completing-read (concat "Edit " (and current-prefix-arg "internal record for ")
"bookmark")
(bmkp-default-bookmark-name))
current-prefix-arg))
(setq bookmark (bmkp-get-bookmark-in-alist bookmark))
(if edit-record-p
(bmkp-edit-bookmark-record bookmark)
(let* ((bookmark-name (bmkp-bookmark-name-from-record bookmark))
(bookmark-filename (bookmark-get-filename bookmark-name))
(new-bmk-name (bmkp-completing-read-lax
"New bookmark name" bookmark-name))
(icicle-unpropertize-completion-result-flag t)
(new-filename (read-file-name
"New file name (location): "
(and bookmark-filename
(file-name-directory bookmark-filename))
bookmark-filename))
(changed-bmk-name-p (and (not (equal new-bmk-name ""))
(not (equal new-bmk-name bookmark-name))))
(changed-filename-p (and (not (equal new-filename ""))
(not (equal new-filename bookmark-filename)))))
(when (or changed-bmk-name-p changed-filename-p)
(when changed-bmk-name-p (bookmark-rename bookmark-name new-bmk-name 'BATCHP))
(when changed-filename-p (bookmark-set-filename new-bmk-name new-filename))
(let ((dired-dir (bookmark-prop-get new-bmk-name 'dired-directory)))
(when (and dired-dir (equal dired-dir bookmark-filename))
(bookmark-prop-set new-bmk-name 'dired-directory new-filename)))
(bmkp-maybe-save-bookmarks)
(when (and bookmark-alist-modification-count
(y-or-n-p "Save changes? "))
(bookmark-save))
(list new-bmk-name new-filename)))))
(define-derived-mode bmkp-edit-bookmark-records-mode emacs-lisp-mode
"Edit Bookmark Records"
"Mode for editing a list of bookmark records, as in `bookmark-alist'.
When you finish editing, use \\<bmkp-edit-bookmark-record-mode-map>\
`\\[bmkp-edit-bookmark-record-send]' in the record-editing buffer."
:group 'bookmark-plus)
(define-key bmkp-edit-bookmark-records-mode-map "\C-c\C-c" 'bmkp-edit-bookmark-records-send)
(defvar bmkp-edit-bookmark-records-number 0
"NUmber of bookmard records being edited.")
(defun bmkp-edit-bookmark-records-send (&optional msg-p)
"Update `bookmark-alist' with buffer contents: a bookmark alist.
Lines beginning with `
Non-interactively, optional arg MSG-P means display progress messages.
This assumes that the bookmarks in the buffer are the marked bookmarks
in `*Bookmark List*'. That is, it assumes that the buffer was created
by `bmkp-bmenu-edit-marked' (`\\<bookmark-bmenu-mode-map>\\[bmkp-bmenu-edit-marked]' in `*Bookmark List*')."
(interactive "p")
(unless (eq major-mode 'bmkp-edit-bookmark-records-mode)
(error "Not in `bmkp-edit-bookmark-records-mode'"))
(when msg-p (message "Reading edited bookmarks..."))
(let ((editbuf (current-buffer))
(read-error-msg
(catch 'bmkp-edit-bookmark-records-send
(let ((edited-bookmarks (condition-case err
(save-excursion (goto-char (point-min)) (read (current-buffer)))
(error (throw 'bmkp-edit-bookmark-records-send
(error-message-string err)))))
(orig-bmks (bmkp-marked-bookmarks-only))
(bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(cond ((not (listp edited-bookmarks))
(throw 'bmkp-edit-bookmark-records-send "Not a list of bookmarks"))
((not (= (length edited-bookmarks) bmkp-edit-bookmark-records-number))
(throw 'bmkp-edit-bookmark-records-send
(format "Need %d bookmarks, but there seem to be %d"
bmkp-edit-bookmark-records-number (length edited-bookmarks)))))
(dolist (edited-bmk edited-bookmarks)
(unless (and (consp edited-bmk) (stringp (car edited-bmk)))
(throw 'bmkp-edit-bookmark-records-send (format "Invalid bookmark: `%s'" edited-bmk)))
(let ((bname (bmkp-bookmark-name-from-record edited-bmk))
(data (bmkp-bookmark-data-from-record edited-bmk)))
(put-text-property 0 (length bname) 'bmkp-full-record edited-bmk bname)
(setcar (car orig-bmks) bname)
(setcdr (car orig-bmks) data)
(unless (memq (car orig-bmks) bmkp-modified-bookmarks)
(setq bmkp-modified-bookmarks (cons (car orig-bmks) bmkp-modified-bookmarks)))
(setq orig-bmks (cdr orig-bmks))))
(setq bmkp-bmenu-marked-bookmarks (mapcar #'bmkp-bookmark-name-from-record
bmkp-modified-bookmarks)
bmkp-sorted-alist (bmkp-sort-omit bookmark-alist)
bookmark-alist-modification-count (1+ bookmark-alist-modification-count)))
nil)))
(if (stringp read-error-msg)
(if msg-p (message "%s --> edit and try again" read-error-msg) (error read-error-msg))
(when (get-buffer editbuf) (kill-buffer editbuf))
(bmkp-refresh/rebuild-menu-list nil (not msg-p)))))
(define-derived-mode bmkp-edit-bookmark-record-mode emacs-lisp-mode
"Edit Bookmark Record"
"Mode for editing an internal bookmark record.
When you finish editing, use \\<bmkp-edit-bookmark-record-mode-map>\
`\\[bmkp-edit-bookmark-record-send]' in the record-editing buffer."
:group 'bookmark-plus)
(define-key bmkp-edit-bookmark-record-mode-map "\C-c\C-c" 'bmkp-edit-bookmark-record-send)
(defun bmkp-edit-bookmark-record (bookmark)
"Edit the full record (the Lisp sexp) for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
When you finish editing, use \\<bmkp-edit-bookmark-record-mode-map>\
`\\[bmkp-edit-bookmark-record-send]' in the record-editing buffer.
The current bookmark list is then updated to reflect your edits."
(interactive (list (bookmark-completing-read "Edit Lisp record for bookmark"
(bmkp-default-bookmark-name))))
(bookmark-maybe-load-default-file)
(setq bmkp-edit-bookmark-orig-record (bmkp-get-bookmark-in-alist bookmark))
(let* ((bmk-copy (copy-sequence bmkp-edit-bookmark-orig-record))
(bname (bmkp-bookmark-name-from-record bmk-copy))
(bufname (format "*Edit Record for Bookmark `%s'*" bname)))
(set-text-properties 0 (length bname) nil bname)
(bookmark-maybe-historicize-string bname)
(bmkp-with-output-to-plain-temp-buffer bufname
(princ
(substitute-command-keys
(concat "
" bname "'\n;;\n"
"
`\\[bmkp-edit-bookmark-record-send]' when done.\n)))
(pp bmk-copy)
(goto-char (point-min)))
(pop-to-buffer bufname)
(buffer-enable-undo)
(with-current-buffer (get-buffer bufname) (bmkp-edit-bookmark-record-mode))))
(defun bmkp-edit-bookmark-record-send (&optional msg-p)
"Update `bookmark-alist' with buffer contents: a bookmark record.
Lines beginning with `
Non-interactively, optional arg MSG-P means display progress messages."
(interactive "p")
(unless (eq major-mode 'bmkp-edit-bookmark-record-mode)
(error "Not in `bmkp-edit-bookmark-record-mode'"))
(unless (and (boundp 'bmkp-edit-bookmark-orig-record) (consp bmkp-edit-bookmark-orig-record))
(error "Lost original bookmark record - try edit command again"))
(when msg-p (message "Reading edited bookmark..."))
(let* ((editbuf (current-buffer))
(bmk-name nil)
(read-error-msg
(catch 'bmkp-edit-bookmark-record-send
(let ((edited-bmk
(condition-case err
(save-excursion (goto-char (point-min)) (read (current-buffer)))
(error (throw 'bmkp-edit-bookmark-record-send (error-message-string err))))))
(unless (and (consp edited-bmk) (stringp (car edited-bmk)))
(throw 'bmkp-edit-bookmark-record-send (format "Invalid bookmark: `%s'" edited-bmk)))
(let ((bname (bmkp-bookmark-name-from-record edited-bmk))
(data (bmkp-bookmark-data-from-record edited-bmk)))
(put-text-property 0 (length bname) 'bmkp-full-record edited-bmk bname)
(setcar bmkp-edit-bookmark-orig-record bname)
(setcdr bmkp-edit-bookmark-orig-record data)
(unless (memq bmkp-edit-bookmark-orig-record bmkp-modified-bookmarks)
(setq bmkp-modified-bookmarks (cons bmkp-edit-bookmark-orig-record
bmkp-modified-bookmarks)))
(setq bmk-name bname))
(setq bmkp-sorted-alist (bmkp-sort-omit bookmark-alist)
bookmark-alist-modification-count (1+ bookmark-alist-modification-count)))
nil)))
(if (stringp read-error-msg)
(if msg-p (message "%s --> edit and try again" read-error-msg) (error read-error-msg))
(when (get-buffer editbuf) (kill-buffer editbuf))
(bmkp-refresh/rebuild-menu-list bmk-name (not msg-p)))
(unless read-error-msg
(setq bmkp-edit-bookmark-orig-record nil))))
(define-derived-mode bmkp-edit-tags-mode emacs-lisp-mode
"Edit Bookmark Tags"
"Mode for editing bookmark tags.
When you have finished composing, type \\[bmkp-edit-tags-send]."
:group 'bookmark-plus)
(define-key bmkp-edit-tags-mode-map "\C-c\C-c" 'bmkp-edit-tags-send)
(defun bmkp-edit-tags (bookmark)
"Edit BOOKMARK's tags, and maybe save the result.
The edited value must be a list each of whose elements is either a
string or a cons whose key is a string.
BOOKMARK is a bookmark name or a bookmark record."
(interactive (list (bookmark-completing-read "Edit tags for bookmark" (bmkp-default-bookmark-name))))
(setq bookmark (bmkp-get-bookmark-in-alist bookmark))
(let* ((btags (bmkp-get-tags bookmark))
(bmkname (bmkp-bookmark-name-from-record bookmark))
(edbuf (format "*Edit Tags for Bookmark `%s'*" bmkname)))
(setq bmkp-return-buffer (current-buffer))
(bmkp-with-output-to-plain-temp-buffer edbuf
(princ
(substitute-command-keys
(concat " bmkname "\"\n;;\n"
"
"
"
")))
(let ((print-circle t)) (pp btags))
(goto-char (point-min)))
(pop-to-buffer edbuf)
(buffer-enable-undo)
(with-current-buffer (get-buffer edbuf) (bmkp-edit-tags-mode))))
(defun bmkp-edit-tags-send (&optional batchp)
"Use buffer contents as the internal form of a bookmark's tags.
DO NOT MODIFY the header comment lines, which begin with `
(interactive)
(unless (eq major-mode 'bmkp-edit-tags-mode) (error "Not in `bmkp-edit-tags-mode'"))
(let (bname)
(unwind-protect
(let (tags bmk)
(goto-char (point-min))
(unless (search-forward ")
(error "Missing header in edit buffer"))
(unless (stringp (setq bname (read (current-buffer))))
(error "Bad bookmark name in edit-buffer header"))
(unless (setq bmk (bmkp-get-bookmark-in-alist bname 'NOERROR))
(error "No such bookmark: `%s'" bname))
(unless (bmkp-bookmark-type bmk) (error "Invalid bookmark"))
(goto-char (point-min))
(setq tags (read (current-buffer)))
(unless (listp tags) (error "Tags sexp is not a list of strings or an alist with string keys"))
(bookmark-prop-set bmk 'tags tags)
(setq bname (bmkp-bookmark-name-from-record bmk))
(bmkp-record-visit bmk batchp)
(bmkp-refresh/rebuild-menu-list bname batchp)
(bmkp-maybe-save-bookmarks)
(unless batchp (message "Updated bookmark file with edited tags")))
(kill-buffer (current-buffer)))
(when bmkp-return-buffer
(pop-to-buffer bmkp-return-buffer)
(when (equal (buffer-name (current-buffer)) "*Bookmark List*")
(bmkp-bmenu-goto-bookmark-named bname)))))
(defun bmkp-bookmark-type (bookmark)
"Return the type of BOOKMARK or nil if no type is recognized.
Return nil if the bookmark record is not recognized (invalid).
See the code for the possible non-nil return values.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(condition-case nil
(progn
(when (stringp bookmark) (setq bookmark (bookmark-get-bookmark bookmark)))
(let ((filep (bookmark-get-filename bookmark)))
(cond ((bmkp-sequence-bookmark-p bookmark) 'bmkp-sequence-bookmark-p)
((bmkp-function-bookmark-p bookmark) 'bmkp-function-bookmark-p)
((bmkp-variable-list-bookmark-p bookmark) 'bmkp-variable-list-bookmark-p)
((bmkp-url-bookmark-p bookmark) 'bmkp-url-bookmark-p)
((bmkp-gnus-bookmark-p bookmark) 'bmkp-gnus-bookmark-p)
((bmkp-desktop-bookmark-p bookmark) 'bmkp-desktop-bookmark-p)
((bmkp-bookmark-file-bookmark-p bookmark) 'bmkp-bookmark-file-bookmark-p)
((bmkp-bookmark-list-bookmark-p bookmark) 'bmkp-bookmark-list-bookmark-p)
((bmkp-man-bookmark-p bookmark) 'bmkp-man-bookmark-p)
((bmkp-info-bookmark-p bookmark) 'bmkp-info-bookmark-p)
((bookmark-get-handler bookmark) 'bookmark-get-handler)
((bmkp-region-bookmark-p bookmark) 'bmkp-region-bookmark-p)
((and filep (bmkp-file-remote-p filep)) 'remote-file)
((and filep (file-directory-p filep)) 'local-directory)
(filep 'local-file)
((and (bmkp-get-buffer-name bookmark)
(or (not filep)
(equal filep bmkp-non-file-filename))) 'buffer)
(t nil))))
(error nil)))
(defun bmkp-record-visit (bookmark &optional batchp)
"Update the data recording a visit to BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
This increments the `visits' entry and sets the `time' entry to the
current time. If either an entry is not present, it is added (with 0
value for `visits').
With non-nil optional arg BATCHP, do not rebuild the menu list.
Although this function modifies BOOKMARK, it does not increment
`bookmark-alist-modification-count', and it does not add BOOKMARK to
`bmkp-modified-bookmarks'. This is so that simply recording the visit
does not count toward needing to save or showing BOOKMARK as modified."
(let ((vis (bookmark-prop-get bookmark 'visits))
(bmkp-modified-bookmarks bmkp-modified-bookmarks))
(if vis (bookmark-prop-set bookmark 'visits (1+ vis)) (bookmark-prop-set bookmark 'visits 0))
(bookmark-prop-set bookmark 'time (current-time))
(unless batchp (bookmark-bmenu-surreptitiously-rebuild-list 'NO-MSG-P))
(let ((bookmark-save-flag nil)) (bmkp-maybe-save-bookmarks 'SAME-COUNT-P))))
(defun bmkp-default-bookmark-name (&optional alist)
"Default bookmark name. See option `bmkp-default-bookmark-name'.
Non-nil ALIST means return nil unless the default names a bookmark in
ALIST."
(let ((bname (if (equal (buffer-name (current-buffer)) "*Bookmark List*")
(bookmark-bmenu-bookmark)
(if (fboundp 'bmkp-default-lighted)
(if (eq 'highlighted bmkp-default-bookmark-name)
(or (bmkp-default-lighted) bookmark-current-bookmark)
(or bookmark-current-bookmark (bmkp-default-lighted)))
bookmark-current-bookmark))))
(when (and bname alist)
(setq bname (bmkp-bookmark-name-from-record (bmkp-bookmark-record-from-name
bname 'NOERROR 'MEMP alist))))
bname))
(defun bmkp-buffer-names ()
"Buffer names used by existing bookmarks that really have buffers.
This excludes buffers for bookmarks such as desktops that are not
really associated with a buffer."
(let ((bufs ())
buf)
(dolist (bmk bookmark-alist)
(when (and (not (bmkp-desktop-bookmark-p bmk))
(not (bmkp-bookmark-file-bookmark-p bmk))
(not (bmkp-sequence-bookmark-p bmk))
(not (bmkp-function-bookmark-p bmk))
(not (bmkp-variable-list-bookmark-p bmk))
(setq buf (bmkp-get-buffer-name bmk)))
(add-to-list 'bufs buf)))
bufs))
(defun bmkp-file-names ()
"The absolute file names used by the existing bookmarks.
This excludes the pseudo file name `bmkp-non-file-filename'."
(let ((files ())
file)
(dolist (bmk bookmark-alist)
(when (and (setq file (bookmark-get-filename bmk)) (not (equal file bmkp-non-file-filename)))
(add-to-list 'files file)))
files))
(defun bmkp-send-bug-report ()
"Send a bug report about a Bookmark+ problem."
(interactive)
(browse-url (format (concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
Bookmark+ bug: \
&body=Describe bug below, using a precise recipe that starts with `emacs -Q' or `emacs -q'. \
Be sure to mention the `Update #' from header of the particular Bookmark+ file header.\
%%0A%%0AEmacs version: %s")
(emacs-version))))
(defun bmkp-toggle-bookmark-set-refreshes ()
"Toggle `bookmark-set' refreshing `bmkp-latest-bookmark-alist'.
Add/remove `bmkp-refresh-latest-bookmark-list' to/from
`bmkp-after-set-hook'."
(interactive)
(if (member 'bmkp-refresh-latest-bookmark-list bmkp-after-set-hook)
(remove-hook 'bmkp-after-set-hook 'bmkp-refresh-latest-bookmark-list)
(add-hook 'bmkp-after-set-hook 'bmkp-refresh-latest-bookmark-list)))
(defun bmkp-refresh-latest-bookmark-list ()
"Refresh `bmkp-latest-bookmark-alist' to reflect `bookmark-alist'."
(setq bmkp-latest-bookmark-alist (if bmkp-bmenu-filter-function
(funcall bmkp-bmenu-filter-function)
bookmark-alist)))
(defun bmkp-toggle-saving-menu-list-state ()
"Toggle the value of option `bmkp-bmenu-state-file'.
Tip: You can use this before quitting Emacs, to not save the state.
If the initial value of `bmkp-bmenu-state-file' is nil, then this
command has no effect."
(interactive)
(unless (or bmkp-last-bmenu-state-file bmkp-bmenu-state-file)
(error "Cannot toggle: initial value of `bmkp-bmenu-state-file' is nil"))
(setq bmkp-last-bmenu-state-file (prog1 bmkp-bmenu-state-file
(setq bmkp-bmenu-state-file bmkp-last-bmenu-state-file)))
(message (if bmkp-bmenu-state-file
"Autosaving of bookmark list state is now ON"
"Autosaving of bookmark list state is now OFF")))
(defun bmkp-save-menu-list-state (&optional msg-p)
"Save menu-list state, unless not saving or list has not yet been shown.
The state is saved to the value of `bmkp-bmenu-state-file'.
Non-interactively, optional arg MSG-P means display progress messages."
(interactive "p")
(when (and (not bmkp-bmenu-first-time-p) bmkp-bmenu-state-file)
(when msg-p (message "Saving bookmark-list display state..."))
(let ((config-list
`((last-sort-comparer . ,bmkp-sort-comparer)
(last-reverse-sort-p . ,bmkp-reverse-sort-p)
(last-reverse-multi-sort-p . ,bmkp-reverse-multi-sort-p)
(last-latest-bookmark-alist . ,(bmkp-maybe-unpropertize-bookmark-names
bmkp-latest-bookmark-alist))
(last-bmenu-omitted-bookmarks . ,(bmkp-maybe-unpropertize-bookmark-names
bmkp-bmenu-omitted-bookmarks 'COPY))
(last-bmenu-marked-bookmarks . ,(bmkp-maybe-unpropertize-bookmark-names
bmkp-bmenu-marked-bookmarks 'COPY))
(last-bmenu-filter-function . ,bmkp-bmenu-filter-function)
(last-bmenu-filter-pattern . ,bmkp-bmenu-filter-pattern)
(last-bmenu-title . ,bmkp-bmenu-title)
(last-bmenu-bookmark . ,(and (get-buffer "*Bookmark List*")
(with-current-buffer
(get-buffer "*Bookmark List*")
(bmkp-maybe-unpropertize-string
(bookmark-bmenu-bookmark) 'COPY))))
(last-specific-buffer . ,(copy-sequence bmkp-last-specific-buffer))
(last-specific-file . ,(copy-sequence bmkp-last-specific-file))
(last-bmenu-toggle-filenames . ,bookmark-bmenu-toggle-filenames)
(last-bmenu-before-hide-marked-alist . ,(bmkp-maybe-unpropertize-bookmark-names
bmkp-bmenu-before-hide-marked-alist 'COPY))
(last-bmenu-before-hide-unmarked-alist . ,(bmkp-maybe-unpropertize-bookmark-names
bmkp-bmenu-before-hide-unmarked-alist 'COPY))
(last-bookmark-file . ,(copy-sequence
(convert-standard-filename
(expand-file-name
bmkp-current-bookmark-file)))))))
(with-current-buffer (find-file-noselect bmkp-bmenu-state-file)
(goto-char (point-min))
(delete-region (point-min) (point-max))
(let ((print-length nil)
(print-level nil)
(print-circle t)
(version-control (case bookmark-version-control
((nil) nil)
(never 'never)
(nospecial version-control)
(t t)))
(require-final-newline t)
(errorp nil))
(pp config-list (current-buffer))
(condition-case nil
(write-file bmkp-bmenu-state-file)
(file-error (setq errorp t) (error "CANNOT WRITE FILE `%s'" bmkp-bmenu-state-file)))
(kill-buffer (current-buffer))
(when (and msg-p (not errorp)) (message "Saving bookmark-list display state...done")))))))
(defun bmkp-toggle-saving-bookmark-file (&optional msg-p)
"Toggle the value of option `bookmark-save-flag'.
If the initial value of `bookmark-save-flag' is nil, then this
command has no effect.
Non-interactively, non-nil MSG-P means display a status message."
(interactive "p")
(unless (or bmkp-last-save-flag-value bookmark-save-flag)
(error "Cannot toggle: initial value of `bookmark-save-flag' is nil"))
(when (and bmkp-last-save-flag-value bookmark-save-flag) (setq bmkp-last-save-flag-value nil))
(setq bmkp-last-save-flag-value (prog1 bookmark-save-flag
(setq bookmark-save-flag bmkp-last-save-flag-value)))
(when msg-p (message (if bookmark-save-flag
"Autosaving of current bookmark file is now ON"
"Autosaving of current bookmark file is now OFF"))))
(defun bmkp-make-function-bookmark (bookmark-name function &optional msg-p)
"Create a bookmark that invokes FUNCTION when \"jumped\" to.
You are prompted for the bookmark name and the name of the function.
But with a prefix arg the last keyboard macro defined is used instead
of prompting you for a function.
Returns the new bookmark (internal record).
Non-interactively, non-nil optional arg MSG-P means display a status
message."
(interactive (let ((icicle-unpropertize-completion-result-flag t))
(list (bmkp-completing-read-lax "Bookmark")
(if (and current-prefix-arg last-kbd-macro)
(read-kbd-macro last-kbd-macro 'NEED-VECTOR)
(completing-read "Function: " obarray 'functionp))
'MSG)))
(unless (or (functionp function) (vectorp function))
(setq function (read-from-whole-string function)))
(bookmark-store bookmark-name `((filename . ,bmkp-non-file-filename)
(position . 0)
(function . ,function)
(handler . bmkp-jump-function))
nil nil (not msg-p))
(let ((new (bmkp-bookmark-record-from-name bookmark-name 'NOERROR)))
(unless (memq new bmkp-latest-bookmark-alist)
(setq bmkp-latest-bookmark-alist (cons new bmkp-latest-bookmark-alist)))
(bookmark-bmenu-surreptitiously-rebuild-list (not msg-p))
new))
(defun bmkp-revert-bookmark-file (&optional msg-p)
"Revert to the bookmarks in the current bookmark file.
This discards all modifications to bookmarks and the bookmark list
\(e.g. added/deleted bookmarks).
This has the same effect as using `C-u \\<bookmark-bmenu-mode-map>\\[bmkp-bmenu-refresh-menu-list]' in \
buffer `*Bookmark List*'.
Non-interactively, non-nil MSG-P means display a status message."
(interactive "p")
(if (and msg-p (not (yes-or-no-p (format "Revert to bookmarks saved in file `%s'? "
bmkp-current-bookmark-file))))
(error "OK - canceled")
(bookmark-load bmkp-current-bookmark-file 'OVERWRITE msg-p)
(bmkp-refresh/rebuild-menu-list nil (not msg-p))))
(defun bmkp-switch-bookmark-file (file &optional batchp)
"Switch to a different bookmark file, FILE.
Return FILE. Interactively, you are prompted for FILE.
Replace all bookmarks in the current bookmark list with those from the
newly loaded FILE. Bookmarks are subsequently saved to FILE.
Optional arg BATCHP is passed to `bookmark-load'."
(interactive
(list (let* ((std-default (bmkp-default-bookmark-file))
(default (if (bmkp-same-file-p bmkp-current-bookmark-file bmkp-last-bookmark-file)
(if (bmkp-same-file-p bmkp-current-bookmark-file std-default)
bookmark-default-file
std-default)
bmkp-last-bookmark-file)))
(bmkp-read-bookmark-file-name "Switch to bookmark file: "
(or (file-name-directory default) "~/")
default t))))
(bookmark-load file t batchp))
(defun bmkp-switch-to-last-bookmark-file (&optional batchp)
"Switch back to the last-used bookmark file.
Replace all currently existing bookmarks with those newly loaded from
the last-used file. Swap the values of `bmkp-last-bookmark-file' and
`bmkp-current-bookmark-file'.
Optional arg BATCHP is passed to `bookmark-load'."
(interactive)
(bookmark-load (or bmkp-last-bookmark-file (bmkp-default-bookmark-file))
t batchp))
(defun bmkp-switch-bookmark-file-create (file &optional batchp)
"Switch to bookmark file FILE, creating it as empty if it does not exist.
Return FILE. Interactively, you are prompted for FILE.
Replace all bookmarks in the current bookmark list with those from the
newly loaded FILE. Bookmarks are subsequently saved to FILE.
If there is no file with the name you provide (FILE), then create a
new, empty bookmark file with that name and use that from now on.
This empties the bookmark list. Interactively, you are required to
confirm this.
Non-nil BATCHP is passed to `bookmark-load'."
(interactive
(list (let* ((std-default (bmkp-default-bookmark-file))
(default (if (bmkp-same-file-p bmkp-current-bookmark-file bmkp-last-bookmark-file)
(if (bmkp-same-file-p bmkp-current-bookmark-file std-default)
bookmark-default-file
std-default)
bmkp-last-bookmark-file)))
(bmkp-read-bookmark-file-name "Switch to bookmark file: "
(or (file-name-directory default) "~/")
default))))
(let ((empty-p nil))
(if (file-readable-p file)
(bookmark-load file t batchp)
(setq empty-p t)
(if (and (not batchp)
(not (y-or-n-p (format "Create and use NEW, EMPTY bookmark file `%s'? " file))))
(error "OK - canceled")
(bmkp-empty-file file)
(bookmark-load file t batchp)))
(unless batchp (message "Bookmark file is now %s`%s'" (if empty-p "EMPTY file " "") file)))
file)
(defun bmkp-read-bookmark-file-name (&optional prompt dir default-filename require-match)
"Read and return an (absolute) bookmark file name.
PROMPT is the prompt to use (default: \"Use bookmark file: \").
DEFAULT-FILENAME is as for `read-file-name', except if nil then the
default is `.emacs.bmk' in the current directory. Regardless what
DEFAULT-FILENAME is, you can enter any file name.
The other args are the same as for `read-file-name'."
(let ((insert-default-directory t)
(icicle-unpropertize-completion-result-flag t))
(expand-file-name
(read-file-name (or prompt "Use bookmark file: ") dir (or default-filename
(if (> emacs-major-version 22)
(list ".emacs.bmk" bookmark-default-file)
".emacs.bmk"))
require-match))))
(defun bmkp-empty-file (file &optional confirmp)
"Empty the bookmark file FILE, or create FILE (empty) if it does not exist.
In either case, FILE will become an empty bookmark file. Return FILE.
NOTE: If FILE already exists and you confirm emptying it, no check is
made that it is in fact a bookmark file before emptying it.
It is simply replaced by an empty bookmark file and saved.
This does NOT also make FILE the current bookmark file. To do that,
use `\\[bmkp-switch-bookmark-file-create]' (`bmkp-switch-bookmark-file-create')."
(interactive (list (let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "Create empty bookmark file: " "~/"))
t))
(setq file (expand-file-name file))
(bookmark-maybe-load-default-file)
(when (and confirmp (file-exists-p file)
(not (y-or-n-p (format "CONFIRM: Empty the existing file `%s'? " file))))
(error "OK - canceled"))
(let ((bookmark-alist ()))
(bookmark-write-file file (if (file-exists-p file)
"Emptying bookmark file `%s'..."
"Creating new, empty bookmark file `%s'...")))
file)
(defun bmkp-crosshairs-highlight ()
"Call `crosshairs-highlight', unless the region is active.
You can add this to hook `bookmark-after-jump-hook'.
You need library `crosshairs.el' to use this command."
(interactive)
(when (> emacs-major-version 21)
(unless (condition-case nil (require 'crosshairs nil t) (error nil))
(error "You need library `crosshairs.el' to use this command"))
(unless mark-active
(let ((crosshairs-overlay-priority (and (boundp 'bmkp-light-priorities)
(1+ (apply #'max
(mapcar #'cdr bmkp-light-priorities))))))
(crosshairs-highlight)))))
(defun bmkp-choose-navlist-from-bookmark-list (bookmark-name &optional alist)
"Choose a bookmark-list bookmark and set the bookmark navigation list.
The navigation-list variable, `bmkp-nav-alist', is set to the list of
bookmarks that would be displayed by `bookmark-bmenu-list' (`C-x r l')
for the chosen bookmark-list bookmark, sorted and filtered as
appropriate.
Instead of choosing a bookmark-list bookmark, you can choose the
pseudo-bookmark `CURRENT *Bookmark List*'. The bookmarks used for the
navigation list are those that would be currently shown in the
`*Bookmark List*' (even if the list is not currently displayed)."
(interactive
(let ((bookmark-alist (cons (bmkp-current-bookmark-list-state) (bmkp-bookmark-list-alist-only))))
(list (bmkp-read-bookmark-for-type "bookmark-list" bookmark-alist nil nil
'bmkp-bookmark-list-history "Choose ")
bookmark-alist)))
(let ((state (let ((bookmark-alist (or alist (cons (bmkp-current-bookmark-list-state)
(bmkp-bookmark-list-alist-only)))))
(bookmark-prop-get bookmark-name 'bookmark-list))))
(let ((bmkp-sort-comparer (cdr (assq 'last-sort-comparer state)))
(bmkp-reverse-sort-p (cdr (assq 'last-reverse-sort-p state)))
(bmkp-reverse-multi-sort-p (cdr (assq 'last-reverse-multi-sort-p state)))
(bmkp-bmenu-omitted-bookmarks (cdr (assq 'last-bmenu-omitted-bookmarks state)))
(bmkp-bmenu-filter-function (cdr (assq 'last-bmenu-filter-function state)))
(bmkp-bmenu-filter-pattern (or (cdr (assq 'last-bmenu-filter-pattern state)) ""))
(bmkp-bmenu-title (cdr (assq 'last-bmenu-title state)))
(bookmark-bmenu-toggle-filenames (cdr (assq 'last-bmenu-toggle-filenames state))))
(setq bmkp-nav-alist (bmkp-sort-omit
(if bmkp-bmenu-filter-function
(funcall bmkp-bmenu-filter-function)
(if (string= "CURRENT *Bookmark List*" bookmark-name)
(or bmkp-latest-bookmark-alist bookmark-alist)
bookmark-alist))
(and (not (eq bmkp-bmenu-filter-function
'bmkp-omitted-alist-only))
bmkp-bmenu-omitted-bookmarks))
bmkp-current-nav-bookmark (car bmkp-nav-alist))))
(message "Bookmark navigation list is now %s"
(if (and (string= "CURRENT *Bookmark List*" bookmark-name)
(not (get-buffer "*Bookmark List*")))
"the global bookmark list"
(format "`%s'" bookmark-name))))
(defun bmkp-current-bookmark-list-state ()
"Pseudo-bookmark for the current `*Bookmark List*' state."
(bookmark-bmenu-surreptitiously-rebuild-list 'NO-MSG-P)
(cons "CURRENT *Bookmark List*" (bmkp-make-bookmark-list-record)))
(defun bmkp-choose-navlist-of-type (type)
"Set the bookmark navigation list to the bookmarks of a type you choose.
The pseudo-type `any' sets the navigation list to all bookmarks.
This sets variable `bmkp-nav-alist'."
(interactive
(let* ((completion-ignore-case t)
(icicle-unpropertize-completion-result-flag t)
(type (completing-read "Type: "
(cons '("any" . bookmark-history)
bmkp-types-alist)
nil t nil nil "any")))
(list type)))
(setq bmkp-nav-alist (if (equal "any" type)
bookmark-alist
(funcall (intern (format "bmkp-%s-alist-only" type)))))
(unless bmkp-nav-alist (error "No bookmarks"))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist))
(message "Bookmark navigation list is now %s"
(if (equal "any" type) "all bookmarks" (format "for type `%s'" type))))
(defun bmkp-autonamed-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an autonamed bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(unless (stringp bookmark) (setq bookmark (bmkp-bookmark-name-from-record bookmark)))
(bmkp-string-match-p (format bmkp-autoname-format ".*") bookmark))
(defun bmkp-autonamed-this-buffer-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an autonamed bookmark for this buffer."
(unless (stringp bookmark) (setq bookmark (bmkp-bookmark-name-from-record bookmark)))
(and (bmkp-string-match-p (format bmkp-autoname-format (buffer-name)) bookmark)
(bmkp-this-buffer-p bookmark)))
(defun bmkp-autonamed-bookmark-for-buffer-p (bookmark buffer-name)
"Return non-nil if BOOKMARK is an autonamed bookmark for BUFFER.
BOOKMARK is a bookmark name or a bookmark record.
BUFFER-NAME is a string matching the buffer-name part of an autoname.
This does not check the `buffer-name' entry of BOOKMARK. It checks
only the buffer indicated by the bookmark name."
(unless (stringp bookmark) (setq bookmark (bmkp-bookmark-name-from-record bookmark)))
(bmkp-string-match-p (format bmkp-autoname-format (regexp-quote buffer-name)) bookmark))
(defun bmkp-update-autonamed-bookmark (bookmark)
"Update the name and position of the autonamed BOOKMARK at point.
Return the updated BOOKMARK: If input was a bookmark name, then return
then new name, else the new (full) bookmark.
It is a good idea to set BOOKMARK to the result of this call.
BOOKMARK is a bookmark name or a bookmark record."
(let ((namep (stringp bookmark)))
(setq bookmark (bookmark-get-bookmark bookmark))
(bookmark-set-position bookmark (point))
(when (bmkp-get-end-position bookmark)
(bookmark-prop-set bookmark 'end-position (point)))
(let ((newname (funcall bmkp-autoname-bookmark-function (point))))
(bookmark-rename (bmkp-bookmark-name-from-record bookmark) newname 'BATCHP)
(bmkp-refresh/rebuild-menu-list (bmkp-bookmark-name-from-record bookmark))
(bmkp-maybe-save-bookmarks))
(if namep (bmkp-bookmark-name-from-record bookmark) bookmark)))
(defun bmkp-this-file/buffer-bmenu-list ()
"Show the bookmark list just for bookmarks for the current file/buffer.
If visiting a file, this is `bmkp-this-file-bmenu-list'. Otherwise,
this is `bmkp-this-buffer-bmenu-list'."
(interactive)
(if (buffer-file-name) (bmkp-this-file-bmenu-list) (bmkp-this-buffer-bmenu-list)))
(defun bmkp-this-file-bmenu-list ()
"Show the bookmark list just for bookmarks for the current file.
Set `bmkp-last-specific-file' to the current file name.
If the current buffer is not visiting a file, prompt for the file name."
(interactive)
(setq bmkp-last-specific-file (or (buffer-file-name)
(let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "File: ")))
bmkp-bmenu-filter-function 'bmkp-last-specific-file-alist-only
bmkp-bmenu-title (format "File `%s' Bookmarks" bmkp-last-specific-file))
(let ((bookmark-alist (funcall bmkp-bmenu-filter-function))
(bmkp-bmenu-state-file nil))
(unless bookmark-alist (error "No bookmarks for file `%s'" bmkp-last-specific-file))
(setq bmkp-latest-bookmark-alist bookmark-alist)
(pop-to-buffer (get-buffer-create "*Bookmark List*"))
(bookmark-bmenu-list 'filteredp))
(when (interactive-p)
(bmkp-msg-about-sort-order (bmkp-current-sort-order)
(format "Only bookmarks for file `%s' are shown"
bmkp-last-specific-file)))
(raise-frame))
(defun bmkp-this-buffer-bmenu-list ()
"Show the bookmark list just for bookmarks for the current buffer.
Set `bmkp-last-specific-buffer' to the current buffer name."
(interactive)
(setq bmkp-last-specific-buffer (buffer-name)
bmkp-bmenu-filter-function 'bmkp-last-specific-buffer-alist-only
bmkp-bmenu-title (format "Buffer `%s' Bookmarks" bmkp-last-specific-buffer))
(let ((bookmark-alist (funcall bmkp-bmenu-filter-function))
(bmkp-bmenu-state-file nil))
(unless bookmark-alist (error "No bookmarks for buffer `%s'" bmkp-last-specific-buffer))
(setq bmkp-latest-bookmark-alist bookmark-alist)
(pop-to-buffer (get-buffer-create "*Bookmark List*"))
(bookmark-bmenu-list 'filteredp))
(when (interactive-p)
(bmkp-msg-about-sort-order (bmkp-current-sort-order)
(format "Only bookmarks for buffer `%s' are shown"
bmkp-last-specific-buffer)))
(raise-frame))
(defun bmkp-navlist-bmenu-list ()
"Show the bookmark list just for bookmarks from the navigation list."
(interactive)
(unless bmkp-nav-alist
(bookmark-maybe-load-default-file)
(setq bmkp-nav-alist bookmark-alist)
(unless bmkp-nav-alist (error "No bookmarks"))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist))
(message "Bookmark navigation list is now the global bookmark list") (sit-for 2))
(setq bmkp-bmenu-title "Current Navlist Bookmarks")
(let ((bookmark-alist bmkp-nav-alist)
(bmkp-bmenu-state-file nil))
(unless bookmark-alist (error "No bookmarks"))
(setq bmkp-latest-bookmark-alist bookmark-alist)
(pop-to-buffer (get-buffer-create "*Bookmark List*"))
(bookmark-bmenu-list 'filteredp))
(when (interactive-p)
(bmkp-msg-about-sort-order (bmkp-current-sort-order)
"Only bookmarks for the navigation list are shown"))
(raise-frame))
(defun bmkp-completing-read-buffer-name (&optional no-default-p)
"Read the name of a buffer associated with a bookmark.
The candidates are the buffers in `bmkp-buffer-names'.
Non-nil NO-DEFAULT-P means provide no default value. Used when
called in a loop, to let the user exit using empty input.
If NO-DEFAULT-P is nil, then the default is the current buffer's name,
or the value of `bmkp-last-specific-buffer' if the current buffer has
no bookmarks."
(bookmark-maybe-load-default-file)
(let ((icicle-unpropertize-completion-result-flag t))
(completing-read "Buffer: " (mapcar #'list (bmkp-buffer-names)) nil t nil 'buffer-name-history
(and (not no-default-p)
(if (member (buffer-name) (bmkp-buffer-names))
(buffer-name)
bmkp-last-specific-buffer)))))
(defun bmkp-completing-read-file-name (&optional no-default-p)
"Read the name of a file associated with a bookmark.
The candidates are the absolute file names in `bmkp-file-names'.
Non-nil NO-DEFAULT-P means provide no default value. Used when
called in a loop, to let the user exit using empty input.
If NO-DEFAULT-P is nil, then the default is the current buffer's file
name, if any, or the value of `bmkp-last-specific-file' if the
current buffer has no associated file or the file has no bookmarks."
(bookmark-maybe-load-default-file)
(let ((completion-ignore-case (if (boundp 'read-file-name-completion-ignore-case)
read-file-name-completion-ignore-case
(memq system-type
'(ms-dos windows-nt darwin cygwin))))
(icicle-unpropertize-completion-result-flag t))
(completing-read "File: " (mapcar #'list (bmkp-file-names)) nil t nil 'file-name-history
(and (not no-default-p)
(let ((file (buffer-file-name)))
(if (and file (member file (bmkp-file-names)))
file
bmkp-last-specific-file))))))
(defun bmkp-refresh/rebuild-menu-list (&optional bookmark no-msg-p)
"Refresh or rebuild buffer `*Bookmark List*'.
If the buffer is already displayed, call `bmkp-refresh-menu-list'.
Otherwise, call `bookmark-bmenu-surreptitiously-rebuild-list'.
Args are the same as for `bmkp-refresh-menu-list'."
(let ((bmklistbuf (get-buffer "*Bookmark List*")))
(if (and bmklistbuf (get-buffer-window bmklistbuf 0))
(with-current-buffer bmklistbuf (bmkp-refresh-menu-list bookmark no-msg-p))
(bookmark-bmenu-surreptitiously-rebuild-list no-msg-p))))
(defun bmkp-refresh-menu-list (&optional bookmark no-msg-p)
"Refresh (revert) the bookmark list (\"menu list\").
This brings the displayed list up to date. It does not change the
current filtering or sorting of the displayed list.
Non-nil optional arg BOOKMARK means move cursor to BOOKMARK's line.
BOOKMARK is a bookmark name or a bookmark record.
Non-nil optional arg NO-MSG-P means do not show progress messages."
(let ((bookmark-alist (if bmkp-bmenu-filter-function
(funcall bmkp-bmenu-filter-function)
bookmark-alist)))
(setq bmkp-latest-bookmark-alist bookmark-alist)
(unless no-msg-p (message "Updating bookmark list..."))
(bookmark-bmenu-list bmkp-bmenu-filter-function)
(when bookmark
(unless (stringp bookmark) (setq bookmark (bmkp-bookmark-name-from-record bookmark)))
(with-current-buffer (get-buffer "*Bookmark List*")
(bmkp-bmenu-goto-bookmark-named bookmark)
(let ((bmenu-win (get-buffer-window (current-buffer) 0)))
(when bmenu-win (set-window-point bmenu-win (point))))))
(unless no-msg-p (message "Updating bookmark list...done"))))
(defun bmkp-unomit-all (&optional msg-p)
"Remove all bookmarks from the list of omitted bookmarks.
After this, all bookmarks are available for display.
Non-interactively, non-nil optional arg MSG-P means display a status
message."
(interactive "p")
(unless bmkp-bmenu-omitted-bookmarks (error "No omitted bookmarks to UN-omit"))
(when msg-p (message "UN-omitting ALL omitted bookmarks..."))
(let ((count 0))
(dolist (bmk-name bmkp-bmenu-omitted-bookmarks)
(setq bmkp-bmenu-omitted-bookmarks (bmkp-delete-bookmark-name-from-list
bmk-name bmkp-bmenu-omitted-bookmarks)
count (1+ count)))
(bookmark-bmenu-surreptitiously-rebuild-list (not msg-p))
(when msg-p (message "UN-omitted %d bookmarks" count)))
(when (equal (buffer-name (current-buffer)) "*Bookmark List*") (bmkp-bmenu-show-all))
(when (and (fboundp 'fit-frame-if-one-window) (equal (buffer-name (current-buffer)) "*Bookmark List*"))
(fit-frame-if-one-window)))
(defun bmkp-omitted-alist-only ()
"`bookmark-alist', filtered to retain only the omitted bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-omitted-bookmark-p bookmark-alist))
(defun bmkp-omitted-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an omitted bookmark.
BOOKMARK is a bookmark name or a bookmark record."
(unless (stringp bookmark) (setq bookmark (bmkp-bookmark-name-from-record bookmark)))
(bmkp-bookmark-name-member bookmark bmkp-bmenu-omitted-bookmarks))
(when (> emacs-major-version 22)
(defvar bmkp-isearch-bookmarks nil
"Bookmarks whose locations are to be incrementally searched.")
(defun bmkp-isearch-next-bookmark-buffer (&optional bookmark wrap)
"Return the next buffer in a series of bookmark buffers.
Used as a value for `multi-isearch-next-buffer-function', for Isearch
of multiple bookmarks.
Variable `bmkp-isearch-bookmarks' is a list of bookmarks. Each
bookmark in the list is visited by `bookmark--jump-via', and the
corresponding bookmark buffer is returned."
(let ((bookmarks (if isearch-forward bmkp-isearch-bookmarks (reverse bmkp-isearch-bookmarks))))
(bookmark--jump-via
(if wrap
(car bookmarks)
(let ((this-bmk (catch 'bmkp-isearch-next-bookmark-buffer
(dolist (bmk bookmarks)
(when (if (bmkp-get-buffer-name bmk)
(equal (bmkp-get-buffer-name bmk) (buffer-name))
(equal (bookmark-get-filename bmk) (buffer-file-name)))
(throw 'bmkp-isearch-next-bookmark-buffer bmk)))
(car bookmarks))))
(cadr (member this-bmk bookmarks))))
'ignore)
(current-buffer)))
(defun bmkp-isearch-bookmarks (bookmarks)
"Start multi-bookmark Isearch on BOOKMARKS."
(let ((multi-isearch-next-buffer-function 'bmkp-isearch-next-bookmark-buffer)
(bmkp-isearch-bookmarks bookmarks))
(bookmark-jump (car bookmarks))
(goto-char (if isearch-forward (point-min) (point-max)))
(isearch-forward)))
(defun bmkp-isearch-bookmarks-regexp (bookmarks)
"Start multi-bookmark regexp Isearch on BOOKMARKS."
(let ((multi-isearch-next-buffer-function 'bmkp-isearch-next-bookmark-buffer)
(bmkp-isearch-bookmarks bookmarks))
(bookmark-jump (car bookmarks))
(goto-char (if isearch-forward (point-min) (point-max)))
(isearch-forward-regexp))))
(defun bmkp-get-tags (bookmark)
"Return the `tags' entry for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(bookmark-prop-get bookmark 'tags))
(defalias 'bmkp-tagged-bookmark-p 'bmkp-get-tags)
(defun bmkp-get-tag-value (bookmark tag)
"Return value of BOOKMARK's tag TAG.
BOOKMARK is a bookmark name or a bookmark record.
TAG is a string.
Return nil if BOOKMARK has no such TAG or if TAG has no value."
(assoc-default tag (bmkp-get-tags bookmark)))
(defun bmkp-has-tag-p (bookmark tag)
"Return non-nil if BOOKMARK is tagged with TAG.
BOOKMARK is a bookmark name or a bookmark record.
TAG is a string."
(assoc-default tag (bmkp-get-tags bookmark) nil t))
(defun bmkp-read-tags ()
"Read tags one by one, and return them as a list."
(let ((tag (read-string "Tag (RET for each, empty input to finish): "))
(btags ()))
(while (not (string= "" tag))
(push tag btags)
(setq tag (read-string "Tag: ")))
btags))
(defun bmkp-read-tag-completing (&optional prompt candidate-tags require-match update-tags-alist-p)
"Read a tag with completion, and return it as a string.
The candidate tags available are determined by option
`bmkp-tags-for-completion'.
PROMPT is the prompt string. If nil, then use \"Tag: \".
CANDIDATE-TAGS is an alist of tags to use for completion.
If nil, then all tags from all bookmarks are used for completion.
The set of all tags is taken from variable `bmkp-tags-alist'.
REQUIRE-MATCH is passed to `completing-read'.
Non-nil UPDATE-TAGS-ALIST-P means update var `bmkp-tags-alist'."
(bookmark-maybe-load-default-file)
(let ((cand-tags (copy-sequence
(or candidate-tags
(and (not update-tags-alist-p)
bmkp-tags-alist)
(bmkp-tags-list))))
(icicle-unpropertize-completion-result-flag t))
(completing-read (or prompt "Tag: ") cand-tags nil require-match nil 'bmkp-tag-history)))
(defun bmkp-read-tags-completing (&optional candidate-tags require-match update-tags-alist-p)
"Read tags with completion, and return them as a list of strings.
Read tags one by one, until you hit `RET' twice consecutively.
CANDIDATE-TAGS is an alist of tags to use for completion.
If nil then the candidate tags are taken from variable
`bmkp-tags-alist'.
REQUIRE-MATCH is passed to `completing-read'.
Non-nil UPDATE-TAGS-ALIST-P means update var `bmkp-tags-alist',
determining the tags to use per option `bmkp-tags-for-completion'."
(bookmark-maybe-load-default-file)
(let ((cands ())
(btags ())
(prompt1 "Tag (RET for each, empty input to finish): ")
(prompt2 "Tag: ")
(icicle-unpropertize-completion-result-flag t)
tag old-tag)
(dolist (full-tag (or candidate-tags
(and (not update-tags-alist-p) bmkp-tags-alist)
(bmkp-tags-list)))
(add-to-list 'cands (list (if (consp full-tag) (car full-tag) full-tag))))
(setq tag (completing-read prompt1 cands nil require-match nil 'bmkp-tag-history)
cands (delete (assoc tag cands) cands))
(while (not (string= "" tag))
(if (member tag btags)
(message "Tag `%s' already included" tag)
(push tag btags))
(setq tag (completing-read prompt2 cands nil require-match nil 'bmkp-tag-history)
cands (delete (assoc tag cands) cands)))
(nreverse btags)))
(defun bmkp-list-all-tags (fullp current-only-p &optional msg-p)
"List bookmark tags.
Show the list in the minibuffer or, if not enough space, in buffer
`*All Tags*'. The tags are listed alphabetically, respecting option
`case-fold-search'.
With no prefix arg or with a plain prefix arg (`C-u'), the tags listed
are those defined by option `bmkp-tags-for-completion'. Otherwise
\(i.e., with a numeric prefix arg), the tags listed are those from the
current list of bookmarks only.
With no prefix arg or with a negative prefix arg (e.g. `C--'), list
only the tag names. With a non-negative prefix arg (e.g. `C-1' or
plain `C-u'), list the full alist of tags.
Note that when the full tags alist is shown, the same tag name appears
once for each of its different values.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (list (and current-prefix-arg (> (prefix-numeric-value current-prefix-arg) 0))
(and current-prefix-arg (not (consp current-prefix-arg)))
'MSG))
(require 'pp)
(when msg-p (message "Gathering tags..."))
(pp-display-expression (sort (bmkp-tags-list (not fullp) current-only-p)
(if fullp
(lambda (t1 t2) (bmkp-string-less-case-fold-p (car t1) (car t2)))
'bmkp-string-less-case-fold-p))
"*All Tags*"))
(defun bmkp-tags-list (&optional names-only-p current-only-p)
"List of all bookmark tags, per option `bmkp-tags-for-completion'.
Non-nil NAMES-ONLY-P means return a list of only the tag names.
Otherwise, return an alist of the full tags and set variable
`bmkp-tags-alist' to that alist, as a cache.
Non-nil CURRENT-ONLY-P means ignore option `bmkp-tags-for-completion'
and return only the tags for the currently loaded bookmarks."
(let ((tags ())
(opt-tags bmkp-tags-for-completion)
bmk-tags)
(when (or (eq opt-tags 'current) current-only-p) (setq opt-tags '(current)))
(dolist (entry opt-tags)
(typecase entry
(cons
(when (eq 'bmkfile (car entry))
(setq entry (cdr entry)
tags (append tags (bmkp-tags-in-bookmark-file entry names-only-p)))))
(string (add-to-list 'tags (if names-only-p entry (list entry))))
(symbol (when (eq entry 'current)
(bookmark-maybe-load-default-file)
(dolist (bmk bookmark-alist)
(setq bmk-tags (bmkp-get-tags bmk))
(dolist (tag bmk-tags)
(add-to-list 'tags (if names-only-p (bmkp-tag-name tag) (bmkp-full-tag tag)))))))))
(unless names-only-p (setq bmkp-tags-alist tags))
tags))
(defun bmkp-tags-in-bookmark-file (file &optional names-only-p)
"Return the list of tags from all bookmarks in bookmark-file FILE.
If FILE is a relative file name, it is expanded in `default-directory.
If FILE does not name a valid, bookmark file then nil is returned.
Non-nil NAMES-ONLY-P means return a list of only the tag names.
Otherwise, return an alist of the full tags.
"
(setq file (expand-file-name file))
(let ((bookmark-save-flag nil)
(bmk-alist ())
(tags ())
bmk-tags)
(if (not (file-readable-p file))
(message "Cannot read bookmark file `%s'" file)
(with-current-buffer (let ((enable-local-variables ())) (find-file-noselect file))
(goto-char (point-min))
(condition-case nil
(progn (bookmark-maybe-upgrade-file-format)
(unless (listp (setq bmk-alist (bookmark-alist-from-buffer))) (error "")))
(error (message "Not a valid bookmark file: `%s'" file))))
(dolist (bmk bmk-alist)
(setq bmk-tags (bmkp-get-tags bmk))
(dolist (tag bmk-tags)
(add-to-list 'tags (if names-only-p (bmkp-tag-name tag) (bmkp-full-tag tag))))))
tags))
(defun bmkp-tag-name (tag)
"Name of TAG. If TAG is an atom, then TAG, else (car TAG)."
(if (atom tag) tag (car tag)))
(defun bmkp-full-tag (tag)
"Full cons entry for TAG. If TAG is a cons, then TAG, else (list TAG)."
(if (consp tag) tag (list tag)))
(defun bmkp-remove-all-tags (bookmark &optional no-update-p msg-p)
"Remove all tags from BOOKMARK.
Non-interactively:
- Non-nil NO-UPDATE-P means do not update `bmkp-tags-alist' and
do not refresh/rebuild the bookmark-list display.
- Non-nil optional arg MSG-P means show a message about the removal."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) nil 'MSG))
(when (and msg-p (null (bmkp-get-tags bookmark))) (error "Bookmark has no tags to remove"))
(let ((nb-removed (and (interactive-p) (length (bmkp-get-tags bookmark)))))
(bookmark-prop-set bookmark 'tags ())
(unless no-update-p (bmkp-tags-list))
(bmkp-maybe-save-bookmarks)
(unless no-update-p
(bmkp-refresh/rebuild-menu-list bookmark (not msg-p)))
(when (and msg-p nb-removed) (message "%d tags removed" nb-removed))))
(defun bmkp-add-tags (bookmark tags &optional no-update-p msg-p)
"Add TAGS to BOOKMARK.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
Completion for the bookmark name is strict.
Completion for tags is lax: you are not limited to existing tags.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them.
Non-interactively:
* TAGS is a list of strings.
* Non-nil MSG-P means display a message about the addition.
* Non-nil NO-UPDATE-P means do not update `bmkp-tags-alist' and
do not refresh/rebuild the bookmark-list display.
The absolute value of the return value is the number of tags added.
If BOOKMARK was untagged before the operation, then the return value
is negative."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name))
(bmkp-read-tags-completing nil nil current-prefix-arg)
nil
'MSG))
(let* ((newtags (copy-alist (bmkp-get-tags bookmark)))
(olen (length newtags)))
(dolist (tag tags) (unless (or (assoc tag newtags) (member tag newtags)) (push tag newtags)))
(bookmark-prop-set bookmark 'tags newtags)
(unless no-update-p (bmkp-tags-list))
(bmkp-maybe-save-bookmarks)
(unless no-update-p
(bmkp-refresh/rebuild-menu-list bookmark (not msg-p)))
(let ((nb-added (- (length newtags) olen)))
(when msg-p (message "%d tags added. Now: %S" nb-added
(let ((tgs (mapcar #'bmkp-tag-name newtags))) (setq tgs (sort tgs #'string<)))))
(when (and (zerop olen) (> (length newtags) 0)) (setq nb-added (- nb-added)))
nb-added)))
(defun bmkp-set-tag-value-for-navlist (tag value)
"Set the value of TAG to VALUE, for each bookmark in the navlist.
If any of the bookmarks has no tag named TAG, then add one with VALUE."
(interactive (list (bmkp-read-tag-completing) (read (read-string "Value: ")) 'msg))
(bmkp-set-tag-value-for-bookmarks bmkp-nav-alist tag value))
(defun bmkp-set-tag-value-for-bookmarks (bookmarks tag value)
"Set the value of TAG to VALUE, for each of the BOOKMARKS.
If any of the BOOKMARKS has no tag named TAG, then add one with VALUE."
(let ((bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk bookmarks) (bmkp-set-tag-value bmk tag value 'NO-UPDATE-P))))
(defun bmkp-set-tag-value (bookmark tag value &optional no-update-p msg-p)
"For BOOKMARK's TAG, set the value to VALUE.
If BOOKMARK has no tag named TAG, then add one with value VALUE.
Non-interactively:
* Non-nil NO-UPDATE-P means do not update `bmkp-tags-alist' and
* do not refresh/rebuild the bookmark-list display.
* Non-nil MSG-P means display a message about the updated value."
(interactive
(let* ((bmk (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)))
(tag (bmkp-read-tag-completing "Tag: " (mapcar 'bmkp-full-tag (bmkp-get-tags bmk)))))
(list bmk tag (read (read-string "Value: ")) nil 'MSG)))
(unless (bmkp-has-tag-p bookmark tag) (bmkp-add-tags bookmark (list tag) no-update-p))
(let* ((newtags (copy-alist (bmkp-get-tags bookmark)))
(assoc-tag (assoc tag newtags))
(member-tag (and (not assoc-tag) (member tag newtags))))
(if assoc-tag (setcdr assoc-tag value) (setcar member-tag (cons (car member-tag) value)))
(bookmark-prop-set bookmark 'tags newtags))
(when msg-p "Tag value set"))
(defun bmkp-remove-tags (bookmark tags &optional no-update-p msg-p)
"Remove TAGS from BOOKMARK.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them.
Non-interactively:
* TAGS is a list of strings. The corresponding tags are removed.
* Non-nil MSG-P means display status messages.
* Non-nil NO-UPDATE-P means do not update `bmkp-tags-alist' and
do not refresh/rebuild the bookmark-list display.
The absolute value of the return value is the number of tags removed.
If BOOKMARK is untagged after the operation, then the return value
is negative."
(interactive (let ((bmk (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name))))
(list bmk
(bmkp-read-tags-completing (mapcar 'bmkp-full-tag (bmkp-get-tags bmk))
t current-prefix-arg)
nil
'MSG)))
(let* ((remtags (copy-alist (bmkp-get-tags bookmark)))
(olen (length remtags)))
(if (null remtags)
(when msg-p (message "Bookmark has no tags to remove"))
(setq remtags (bmkp-remove-if (lexical-let ((tgs tags))
(lambda (tag)
(if (atom tag) (member tag tgs) (member (car tag) tgs))))
remtags))
(bookmark-prop-set bookmark 'tags remtags)
(unless no-update-p (bmkp-tags-list))
(bmkp-maybe-save-bookmarks)
(unless no-update-p
(bmkp-refresh/rebuild-menu-list bookmark (not msg-p)))
(let ((nb-removed (- olen (length remtags))))
(when msg-p (message "%d tags removed. Now: %S" nb-removed
(let ((tgs (mapcar #'bmkp-tag-name remtags)))
(setq tgs (sort tgs #'string<)))))
(when (and (zerop (length remtags)) (> olen 0)) (setq nb-removed (- nb-removed)))
nb-removed))))
(defun bmkp-remove-tags-from-all (tags &optional msg-p)
"Remove TAGS from all bookmarks.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter each tag.
This affects all bookmarks, even those not showing in bookmark list.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them.
Non-interactively:
* TAGS is a list of strings. The corresponding tags are removed.
* Non-nil optional arg MSG-P means show a message about the deletion."
(interactive
(if (not (y-or-n-p "Delete the tags you specify from ALL bookmarks? "))
(error "OK - deletion canceled")
(list (bmkp-read-tags-completing nil t current-prefix-arg) 'MSG)))
(let ((bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk (bookmark-all-names)) (bmkp-remove-tags bmk tags 'NO-UPDATE-P)))
(bmkp-tags-list)
(when msg-p (message "Tags removed from all bookmarks: %S" tags)))
(defun bmkp-rename-tag (tag newname &optional msg-p)
"Rename TAG to NEWNAME in all bookmarks, even those not showing.
Non-interactively, non-nil MSG-P means display a message about the
deletion."
(interactive (list (bmkp-read-tag-completing "Tag (old name): ")
(bmkp-read-tag-completing "New name: ")
'MSG))
(let ((tag-exists-p nil)
(bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk (bookmark-all-names))
(let ((newtags (copy-alist (bmkp-get-tags bmk))))
(when newtags
(let* ((assoc-tag (assoc tag newtags))
(member-tag (and (not assoc-tag) (member tag newtags))))
(cond (assoc-tag (setcar assoc-tag newname))
(member-tag (setcar member-tag newname)))
(when (or assoc-tag member-tag)
(setq tag-exists-p t)
(bookmark-prop-set bmk 'tags newtags))))))
(unless tag-exists-p (error "No such tag: `%s'" tag))
(bmkp-tags-list)
(when msg-p (message "Renamed"))))
(defun bmkp-copy-tags (bookmark &optional msg-p)
"Copy tags from BOOKMARK, so you can paste them to another bookmark.
Note that you can copy from a BOOKMARK that has no tags or has an
empty tags list. In that case, the copied-tags list is empty, so if
you paste it as a replacement then the recipient bookmark will end up
with no tags.
Non-interactively, non-nil MSG-P means display a message about the
number of tags copied."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) 'MSG))
(let ((btags (bmkp-get-tags bookmark)))
(setq bmkp-copied-tags (copy-alist btags))
(when msg-p (message "%d tags now available for pasting" (length btags)))))
(defun bmkp-paste-add-tags (bookmark &optional no-update-p msg-p)
"Add tags to BOOKMARK that were previously copied from another bookmark.
Return the number of tags added.
The tags are copied from `bmkp-copied-tags'.
Non-interactively:
* Non-nil NO-UPDATE-P means do not update `bmkp-tags-alist' and
do not refresh/rebuild the bookmark-list display.
* Non-nil MSG-P means display a message about the addition."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) nil 'MSG))
(unless (listp bmkp-copied-tags) (error "`bmkp-paste-add-tags': `bmkp-copied-tags' is not a list"))
(bmkp-add-tags bookmark bmkp-copied-tags no-update-p msg-p))
(defun bmkp-paste-replace-tags (bookmark &optional no-update-p msg-p)
"Replace tags for BOOKMARK with those copied from another bookmark.
Return the number of tags for BOOKMARK.
The tags are copied from `bmkp-copied-tags'.
Any previously existing tags for BOOKMARK are lost.
Non-interactively:
* Non-nil NO-UPDATE-P means do not update `bmkp-tags-alist' and
do not refresh/rebuild the bookmark-list display.
* Non-nil MSG-P means display a message about the addition."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) nil 'MSG))
(unless (listp bmkp-copied-tags)
(error "`bmkp-paste-replace-tags': `bmkp-copied-tags' is not a list"))
(let ((has-tags-p (bmkp-get-tags bookmark)))
(when (and msg-p has-tags-p
(not (y-or-n-p "Existing tags will be LOST - really replace them? ")))
(error "OK - paste-replace tags canceled"))
(when has-tags-p (bmkp-remove-all-tags bookmark no-update-p msg-p) (sleep-for 0.5)))
(bmkp-add-tags bookmark bmkp-copied-tags no-update-p msg-p))
(defun bmkp-autofile-bookmark-p (bookmark &optional prefix)
"Return non-nil if BOOKMARK is an autofile bookmark.
That means that it is `bmkp-file-bookmark-p' and also its
non-directory file name is the same as the bookmark name.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'.
Non-interactively, non-nil optional arg PREFIX means that the bookmark
name is actually expected to be the file name prefixed by PREFIX (a
string)."
(setq bookmark (bookmark-get-bookmark bookmark))
(and (bmkp-file-bookmark-p bookmark)
(let ((fname (file-name-nondirectory (bookmark-get-filename bookmark))))
(string= (if prefix (concat prefix fname) fname)
(bmkp-bookmark-name-from-record bookmark)))))
(defun bmkp-bookmark-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a bookmark-file bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-bookmark-file))
(defun bmkp-bookmark-list-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a bookmark-list bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-bookmark-list))
(defun bmkp-desktop-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a desktop bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-desktop))
(defun bmkp-dired-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Dired bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(or (eq (bookmark-get-handler bookmark) 'bmkp-jump-dired)
(bmkp-local-directory-bookmark-p bookmark)))
(defun bmkp-dired-this-dir-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Dired bookmark for the `default-directory'.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(and (bmkp-dired-bookmark-p bookmark)
(let ((dir (file-name-directory (bookmark-get-filename bookmark))))
(bmkp-same-file-p dir default-directory))))
(defun bmkp-dired-wildcards-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a Dired buffer with wildcards.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark))
(and (bmkp-dired-bookmark-p bookmark)
(let ((file (bookmark-get-filename bookmark)))
(and (stringp file) (bmkp-string-match-p (regexp-quote "*") file)))))
(defun bmkp-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a file or directory.
This excludes bookmarks of a more specific kind (e.g. Info, Gnus).
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let* ((filename (bookmark-get-filename bookmark))
(nonfile-p (equal filename bmkp-non-file-filename))
(handler (bookmark-get-handler bookmark)))
(and filename (not nonfile-p)
(or (not handler)
(memq handler bmkp-file-bookmark-handlers)
(equal handler (bmkp-default-handler-for-file filename)))
(not (bookmark-prop-get bookmark 'info-node)))))
(defun bmkp-file-this-dir-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks file/subdir in `default-directory'.
This excludes bookmarks of a more specific kind (e.g. Info, Gnus).
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(and (bmkp-file-bookmark-p bookmark)
(equal (file-name-directory (bookmark-get-filename bookmark)) default-directory)))
(defun bmkp-flagged-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is flagged for deletion in `*Bookmark List*'.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark))
(memq bookmark bmkp-flagged-bookmarks))
(defun bmkp-function-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a function bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-function))
(defun bmkp-gnus-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a Gnus bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(memq (bookmark-get-handler bookmark)
'(gnus-summary-bookmark-jump bmkp-jump-gnus bmkext-jump-gnus)))
(defun bmkp-image-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an image-file bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(or (eq (bookmark-get-handler bookmark) 'image-bookmark-jump)
(and (fboundp 'image-file-name-regexp)
(bmkp-file-bookmark-p bookmark)
(not (bmkp-dired-bookmark-p bookmark))
(bmkp-string-match-p (image-file-name-regexp) (bookmark-get-filename bookmark)))))
(defun bmkp-info-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an Info bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(or (eq (bookmark-get-handler bookmark) 'Info-bookmark-jump)
(and (not (bookmark-get-handler bookmark))
(or (string= "*info*" (bmkp-get-buffer-name bookmark))
(bookmark-prop-get bookmark 'info-node)))))
(defun bmkp-local-directory-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a local directory.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let ((file (bookmark-get-filename bookmark)))
(and (bmkp-local-file-bookmark-p bookmark) (file-directory-p file))))
(defun bmkp-local-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a local file or directory.
This excludes bookmarks of a more specific kind (e.g. Info, Gnus).
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(and (bmkp-file-bookmark-p bookmark) (not (bmkp-remote-file-bookmark-p bookmark))))
(defun bmkp-man-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a `man' page bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(memq (bookmark-get-handler bookmark) '(bmkp-jump-man bmkp-jump-woman
bmkext-jump-man bmkext-jump-woman)))
(defun bmkp-marked-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a marked bookmark in `*Bookmark List*'.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(unless (stringp bookmark) (setq bookmark (bmkp-bookmark-name-from-record bookmark)))
(bmkp-bookmark-name-member bookmark bmkp-bmenu-marked-bookmarks))
(defun bmkp-modified-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a modified bookmark'.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark))
(memq bookmark bmkp-modified-bookmarks))
(defun bmkp-non-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a non-file bookmark (e.g *scratch*).
This excludes bookmarks of a more specific kind (e.g. Info, Gnus).
It includes bookmarks to existing buffers, as well as bookmarks
defined for buffers that do not currently exist.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let* ((filename (bookmark-get-filename bookmark))
(nonfile-p (equal filename bmkp-non-file-filename)))
(and (bmkp-get-buffer-name bookmark)
(or (not filename) nonfile-p
(and (not (bmkp-file-remote-p filename)) (not (file-exists-p filename))))
(not (bookmark-get-handler bookmark)))))
(defun bmkp-orphaned-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an orphaned file or directory bookmark.
This means that the file recorded for BOOKMARK does not exist or is
not readable. But a Dired bookmark with wildcards in the file name is
assumed to be readable.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark))
(and (bmkp-file-bookmark-p bookmark)
(if (bmkp-dired-bookmark-p bookmark)
(and (not (bmkp-dired-wildcards-bookmark-p bookmark))
(not (file-readable-p (bookmark-get-filename bookmark))))
(not (file-readable-p (bookmark-get-filename bookmark))))))
(defun bmkp-orphaned-local-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an orphaned local-file bookmark.
This means that the file name recorded for BOOKMARK is not remote, and
the file does not exist or is not readable. But a Dired bookmark with
wildcards in the file name is assumed to be readable.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark))
(and (bmkp-local-file-bookmark-p bookmark)
(if (bmkp-dired-bookmark-p bookmark)
(and (not (bmkp-dired-wildcards-bookmark-p bookmark))
(not (file-readable-p (bookmark-get-filename bookmark))))
(not (file-readable-p (bookmark-get-filename bookmark))))))
(defun bmkp-orphaned-remote-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is an orphaned remote-file bookmark.
This means that the file name recorded for BOOKMARK is remote, and the
file does not exist or is not readable. But a Dired bookmark with
wildcards in the file name is assumed to be readable.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark))
(and (bmkp-remote-file-bookmark-p bookmark)
(if (bmkp-dired-bookmark-p bookmark)
(and (not (bmkp-dired-wildcards-bookmark-p bookmark))
(not (file-readable-p (bookmark-get-filename bookmark))))
(not (file-readable-p (bookmark-get-filename bookmark))))))
(defun bmkp-region-bookmark-p (bookmark)
"Return non-nil if BOOKMARK has region information.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(and (bmkp-get-end-position bookmark)
(/= (bookmark-get-position bookmark) (bmkp-get-end-position bookmark))))
(defun bmkp-remote-file-bookmark-p (bookmark)
"Return non-nil if BOOKMARK bookmarks a remote file or directory.
This includes remote Dired bookmarks, but otherwise excludes bookmarks
with handlers (e.g. Info, Gnus).
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let* ((handler (bookmark-get-handler bookmark))
(file (bookmark-get-filename bookmark))
(rem-file (and file (bmkp-file-remote-p file))))
(and rem-file (or (not handler) (eq handler 'bmkp-jump-dired)))))
(defun bmkp-temporary-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is temporary.
This means that it has a non-nil `bmkp-temp' property.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(setq bookmark (bookmark-get-bookmark bookmark 'NOERROR))
(if (not bookmark) nil (bookmark-prop-get bookmark 'bmkp-temp)))
(defun bmkp-this-buffer-p (bookmark)
"Return non-nil if BOOKMARK's buffer is the current buffer.
But return nil if BOOKMARK has an associated file, but it is not the
buffer's file.
And return nil for bookmarks, such as desktops, that are not really
associated with a buffer, even if they have a `buffer-name' entry.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(and (let ((this-file (condition-case nil (bookmark-buffer-file-name) (error nil)))
(bmk-file (and (bmkp-file-bookmark-p bookmark) (bookmark-get-filename bookmark))))
(or (and (not this-file) (not bmk-file) (equal (bmkp-get-buffer-name bookmark) (buffer-name)))
(and this-file bmk-file (bmkp-same-file-p this-file bmk-file))))
(not (bmkp-desktop-bookmark-p bookmark))
(not (bmkp-bookmark-file-bookmark-p bookmark))
(not (bmkp-sequence-bookmark-p bookmark))
(not (bmkp-function-bookmark-p bookmark))
(not (bmkp-variable-list-bookmark-p bookmark))))
(defun bmkp-this-file-p (bookmark)
"Return non-nil if BOOKMARK's file is the visited file.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let ((bmk-file (and (bmkp-file-bookmark-p bookmark) (bookmark-get-filename bookmark)))
(this-file (or (and (buffer-file-name) (bookmark-buffer-file-name))
(and (eq major-mode 'dired-mode) (if (consp dired-directory)
(car dired-directory)
dired-directory)))))
(and bmk-file (bmkp-same-file-p this-file bmk-file))))
(defun bmkp-last-specific-buffer-p (bookmark)
"Return t if BOOKMARK's `buffer-name' is `bmkp-last-specific-buffer'.
But return nil for bookmarks, such as desktops, that are not really
associated with a buffer, even if they have a `buffer-name' entry.
It does not matter whether the buffer exists.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let ((buf (bmkp-get-buffer-name bookmark)))
(and buf (string= buf bmkp-last-specific-buffer)
(not (bmkp-desktop-bookmark-p bookmark))
(not (bmkp-bookmark-file-bookmark-p bookmark))
(not (bmkp-sequence-bookmark-p bookmark))
(not (bmkp-function-bookmark-p bookmark))
(not (bmkp-variable-list-bookmark-p bookmark)))))
(defun bmkp-last-specific-file-p (bookmark)
"Return t if BOOKMARK's `filename' is `bmkp-last-specific-file'.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(let ((file (bookmark-get-filename bookmark)))
(and file (string= file bmkp-last-specific-file))))
(defun bmkp-sequence-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a sequence bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-sequence))
(defun bmkp-url-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a URL bookmark.
This means that it satifies either `bmkp-url-browse-bookmark-p' or
`bmkp-w3m-bookmark-p'.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(or (bmkp-url-browse-bookmark-p bookmark) (bmkp-w3m-bookmark-p bookmark)))
(defun bmkp-url-browse-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a `browse-url' bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-url-browse))
(defun bmkp-variable-list-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a variable-list bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(eq (bookmark-get-handler bookmark) 'bmkp-jump-variable-list))
(defun bmkp-w3m-bookmark-p (bookmark)
"Return non-nil if BOOKMARK is a W3M bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(memq (bookmark-get-handler bookmark) '(bmkp-jump-w3m bmkext-jump-w3m)))
(defun bmkp-all-tags-alist-only (tags)
"`bookmark-alist', but with only bookmarks having all their tags in TAGS.
Does not include bookmarks that have no tags.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lambda (bmk)
(lexical-let* ((tgs tags)
(bmk-tags (bmkp-get-tags bmk)))
(and bmk-tags (bmkp-every (lambda (tag) (member (bmkp-tag-name tag) tgs)) bmk-tags))))
bookmark-alist))
(defun bmkp-all-tags-regexp-alist-only (regexp)
"`bookmark-alist', but with only bookmarks having all tags match REGEXP.
Does not include bookmarks that have no tags.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk)
(let ((bmk-tags (bmkp-get-tags bmk)))
(and bmk-tags
(bmkp-every (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag))) bmk-tags)))))
bookmark-alist))
(defun bmkp-annotated-alist-only ()
"`bookmark-alist', but only for bookmarks with non-empty annotations.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lambda (bmk)
(let ((annotation (bookmark-get-annotation bmk)))
(and annotation (not (string-equal annotation "")))))
bookmark-alist))
(defun bmkp-autofile-alist-only (&optional prefix)
"`bookmark-alist', filtered to retain only autofile bookmarks.
With non-nil arg PREFIX, the bookmark names must all have that PREFIX."
(bookmark-maybe-load-default-file)
(if (not prefix)
(bmkp-remove-if-not #'bmkp-autofile-bookmark-p bookmark-alist)
(bmkp-remove-if-not (lexical-let ((pref prefix)) (lambda (bmk) (bmkp-autofile-bookmark-p bmk pref)))
bookmark-alist)))
(defun bmkp-autofile-all-tags-alist-only (tags)
"`bookmark-alist', with only autofiles having all tags in TAGS.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((tgs tags))
(lambda (bmk)
(and (bmkp-autofile-bookmark-p bmk) (bmkp-get-tags bmk)
(bmkp-every (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag))) tgs))))
bookmark-alist))
(defun bmkp-autofile-all-tags-regexp-alist-only (regexp)
"`bookmark-alist', with only autofiles having all tags match REGEXP.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk)
(and (bmkp-autofile-bookmark-p bmk)
(let ((bmk-tags (bmkp-get-tags bmk)))
(and bmk-tags
(bmkp-every (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag))) bmk-tags))))))
bookmark-alist))
(defun bmkp-autofile-some-tags-alist-only (tags)
"`bookmark-alist', with only autofiles having some tags in TAGS.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lambda (bmk) (and (bmkp-autofile-bookmark-p bmk)
(bmkp-some (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag))) tags)))
bookmark-alist))
(defun bmkp-autofile-some-tags-regexp-alist-only (regexp)
"`bookmark-alist', with only autofiles having some tags match REGEXP.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk) (and (bmkp-autofile-bookmark-p bmk)
(bmkp-some (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
(bmkp-get-tags bmk)))))
bookmark-alist))
(defun bmkp-autonamed-alist-only ()
"`bookmark-alist', with only autonamed bookmarks (from any buffers).
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-autonamed-bookmark-p bookmark-alist))
(defun bmkp-autonamed-this-buffer-alist-only ()
"`bookmark-alist', with only autonamed bookmarks for the current buffer.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lambda (bmk) (bmkp-autonamed-this-buffer-bookmark-p bmk)) bookmark-alist))
(defun bmkp-bookmark-file-alist-only ()
"`bookmark-alist', filtered to retain only bookmark-file bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-bookmark-file-bookmark-p bookmark-alist))
(defun bmkp-bookmark-list-alist-only ()
"`bookmark-alist', filtered to retain only bookmark-list bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-bookmark-list-bookmark-p bookmark-alist))
(defun bmkp-desktop-alist-only ()
"`bookmark-alist', filtered to retain only desktop bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-desktop-bookmark-p bookmark-alist))
(defun bmkp-dired-alist-only ()
"`bookmark-alist', filtered to retain only Dired bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-dired-bookmark-p bookmark-alist))
(defun bmkp-dired-this-dir-alist-only ()
"`bookmark-alist', with only Dired bookmarks for the current directory.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-dired-this-dir-bookmark-p bookmark-alist))
(defun bmkp-file-alist-only ()
"`bookmark-alist', filtered to retain only file and directory bookmarks.
This excludes bookmarks that might contain file information but are
particular in some way - for example, Info bookmarks or Gnus bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-file-bookmark-p bookmark-alist))
(defun bmkp-file-all-tags-alist-only (tags)
"`bookmark-alist', with only file bookmarks having all tags in TAGS.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((tgs tags))
(lambda (bmk)
(and (bmkp-file-bookmark-p bmk) (bmkp-get-tags bmk)
(bmkp-every (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag))) tgs))))
bookmark-alist))
(defun bmkp-file-all-tags-regexp-alist-only (regexp)
"`bookmark-alist', with only file bookmarks having all tags match REGEXP.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk)
(and (bmkp-file-bookmark-p bmk)
(let ((bmk-tags (bmkp-get-tags bmk)))
(and bmk-tags
(bmkp-every (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag))) bmk-tags))))))
bookmark-alist))
(defun bmkp-file-some-tags-alist-only (tags)
"`bookmark-alist', with only file bookmarks having some tags in TAGS.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((tgs tags))
(lambda (bmk) (and (bmkp-file-bookmark-p bmk)
(bmkp-some (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag))) tgs))))
bookmark-alist))
(defun bmkp-file-some-tags-regexp-alist-only (regexp)
"`bookmark-alist', with only file bookmarks having some tags match REGEXP.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk) (and (bmkp-file-bookmark-p bmk)
(bmkp-some (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
(bmkp-get-tags bmk)))))
bookmark-alist))
(defun bmkp-file-this-dir-alist-only ()
"`bookmark-alist', filtered with `bmkp-file-this-dir-bookmark-p'.
Include only files and subdir that are in `default-directory'.
This excludes bookmarks that might contain file information but are
particular in some way - for example, Info bookmarks or Gnus bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-file-this-dir-bookmark-p bookmark-alist))
(defun bmkp-file-this-dir-all-tags-alist-only (tags)
"`bookmark-alist', for files in this dir having all tags in TAGS.
Include only files and subdir that are in `default-directory'.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((tgs tags))
(lambda (bmk)
(and (bmkp-file-this-dir-bookmark-p bmk) (bmkp-get-tags bmk)
(bmkp-every (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag))) tgs))))
bookmark-alist))
(defun bmkp-file-this-dir-all-tags-regexp-alist-only (regexp)
"`bookmark-alist', for files in this dir having all tags match REGEXP.
Include only files and subdir that are in `default-directory'.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk)
(and (bmkp-file-this-dir-bookmark-p bmk)
(let ((bmk-tags (bmkp-get-tags bmk)))
(and bmk-tags
(bmkp-every (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag))) bmk-tags))))))
bookmark-alist))
(defun bmkp-file-this-dir-some-tags-alist-only (tags)
"`bookmark-alist', for files in this dir having some tags in TAGS.
Include only files and subdir that are in `default-directory'.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((tgs tags))
(lambda (bmk) (and (bmkp-file-this-dir-bookmark-p bmk)
(bmkp-some (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag))) tgs))))
bookmark-alist))
(defun bmkp-file-this-dir-some-tags-regexp-alist-only (regexp)
"`bookmark-alist', for files in this dir having some tags match REGEXP.
Include only files and subdir that are in `default-directory'.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lexical-let ((rg regexp))
(lambda (bmk) (and (bmkp-file-this-dir-bookmark-p bmk)
(bmkp-some (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
(bmkp-get-tags bmk)))))
bookmark-alist))
(defun bmkp-gnus-alist-only ()
"`bookmark-alist', filtered to retain only Gnus bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-gnus-bookmark-p bookmark-alist))
(defun bmkp-image-alist-only ()
"`bookmark-alist', filtered to retain only image-file bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-image-bookmark-p bookmark-alist))
(defun bmkp-info-alist-only ()
"`bookmark-alist', filtered to retain only Info bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-info-bookmark-p bookmark-alist))
(defun bmkp-last-specific-buffer-alist-only ()
"`bookmark-alist', but only for `bmkp-last-specific-buffer'.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-last-specific-buffer-p bookmark-alist))
(defun bmkp-last-specific-file-alist-only ()
"`bookmark-alist', but only for `bmkp-last-specific-file'.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-last-specific-file-p bookmark-alist))
(defun bmkp-man-alist-only ()
"`bookmark-alist', filtered to retain only `man' page bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-man-bookmark-p bookmark-alist))
(defun bmkp-local-file-alist-only ()
"`bookmark-alist', filtered to retain only local-file bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-local-file-bookmark-p bookmark-alist))
(defun bmkp-non-autonamed-alist-only ()
"`bookmark-alist', with only non-autonamed bookmarks (from any buffers).
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lambda (bmk) (not (bmkp-autonamed-bookmark-p bmk))) bookmark-alist))
(defun bmkp-non-file-alist-only ()
"`bookmark-alist', filtered to retain only non-file bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-non-file-bookmark-p bookmark-alist))
(defun bmkp-orphaned-file-alist-only ()
"`bookmark-alist', filtered to retain only orphaned file bookmarks."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-orphaned-file-bookmark-p bookmark-alist))
(defun bmkp-orphaned-local-file-alist-only ()
"`bookmark-alist', but retaining only orphaned local-file bookmarks."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-orphaned-local-file-bookmark-p bookmark-alist))
(defun bmkp-orphaned-remote-file-alist-only ()
"`bookmark-alist', but retaining only orphaned remote-file bookmarks."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-orphaned-remote-file-bookmark-p bookmark-alist))
(defun bmkp-regexp-filtered-annotation-alist-only ()
"`bookmark-alist' for annotations matching `bmkp-bmenu-filter-pattern'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not
(lambda (bmk)
(let ((annot (bookmark-get-annotation bmk)))
(and (stringp annot) (not (string= "" annot))
(bmkp-string-match-p bmkp-bmenu-filter-pattern annot))))
bookmark-alist))
(defun bmkp-regexp-filtered-bookmark-name-alist-only ()
"`bookmark-alist' for bookmarks matching `bmkp-bmenu-filter-pattern'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lambda (bmk) (bmkp-string-match-p bmkp-bmenu-filter-pattern (car bmk)))
bookmark-alist))
(defun bmkp-regexp-filtered-file-name-alist-only ()
"`bookmark-alist' for files matching `bmkp-bmenu-filter-pattern'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lambda (bmk) (let ((fname (bookmark-get-filename bmk)))
(and fname (bmkp-string-match-p bmkp-bmenu-filter-pattern fname))))
bookmark-alist))
(defun bmkp-regexp-filtered-tags-alist-only ()
"`bookmark-alist' for tags matching `bmkp-bmenu-filter-pattern'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lambda (bmk)
(let ((bmk-tags (bmkp-get-tags bmk)))
(and bmk-tags (bmkp-some (lambda (tag)
(bmkp-string-match-p bmkp-bmenu-filter-pattern
(bmkp-tag-name tag)))
bmk-tags))))
bookmark-alist))
(defun bmkp-region-alist-only ()
"`bookmark-alist', filtered to retain only bookmarks that have regions.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-region-bookmark-p bookmark-alist))
(defun bmkp-remote-file-alist-only ()
"`bookmark-alist', filtered to retain only remote-file bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-remote-file-bookmark-p bookmark-alist))
(defun bmkp-sequence-alist-only ()
"`bookmark-alist', filtered to retain only sequence bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-sequence-bookmark-p bookmark-alist))
(defun bmkp-some-tags-alist-only (tags)
"`bookmark-alist', but with only bookmarks having some tags in TAGS.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lexical-let ((tgs tags))
(lambda (bmk)
(bmkp-some (lexical-let ((bk bmk)) (lambda (tag) (bmkp-has-tag-p bk tag)))
tgs)))
bookmark-alist))
(defun bmkp-some-tags-regexp-alist-only (regexp)
"`bookmark-alist', but with only bookmarks having some tags match REGEXP.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lexical-let ((rg regexp))
(lambda (bmk)
(bmkp-some (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
(bmkp-get-tags bmk))))
bookmark-alist))
(defun bmkp-specific-buffers-alist-only (&optional buffers)
"`bookmark-alist', filtered to retain only bookmarks to buffers BUFFERS.
BUFFERS is a list of buffer names.
It defaults to a singleton list with the current buffer's name.
A new list is returned (no side effects).
Note: Bookmarks created by vanilla Emacs do not record the buffer
name. They are therefore excluded from the returned alist."
(unless buffers (setq buffers (list (buffer-name))))
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lexical-let ((bufs buffers))
(lambda (bmk)
(and (not (bmkp-desktop-bookmark-p bmk))
(not (bmkp-bookmark-file-bookmark-p bmk))
(not (bmkp-sequence-bookmark-p bmk))
(not (bmkp-function-bookmark-p bmk))
(not (bmkp-variable-list-bookmark-p bmk))
(member (bmkp-get-buffer-name bmk) bufs))))
bookmark-alist))
(defun bmkp-specific-files-alist-only (&optional files)
"`bookmark-alist', filtered to retain only bookmarks to files FILES.
FILES is a list of absolute file names.
It defaults to a singleton list with the current buffer's file name.
A new list is returned (no side effects)."
(unless files (setq files (list (buffer-file-name))))
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (lexical-let ((ff files)) (lambda (bmk) (member (bookmark-get-filename bmk) ff)))
bookmark-alist))
(defun bmkp-temporary-alist-only ()
"`bookmark-alist', filtered to retain only temporary bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-temporary-bookmark-p bookmark-alist))
(defun bmkp-this-file/buffer-alist-only ()
"`bookmark-alist', with only bookmarks for the current file/buffer.
A new list is returned (no side effects).
If visiting a file, this is `bmkp-this-file-alist-only'.
Otherwise, this is `bmkp-this-buffer-alist-only'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not (if (buffer-file-name) #'bmkp-this-file-p #'bmkp-this-buffer-p) bookmark-alist))
(defun bmkp-this-buffer-alist-only ()
"`bookmark-alist', with only bookmarks for the current buffer.
A new list is returned (no side effects).
See `bmkp-this-buffer-p'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-this-buffer-p bookmark-alist))
(defun bmkp-this-file-alist-only ()
"`bookmark-alist', with only bookmarks for the current file.
A new list is returned (no side effects).
See `bmkp-this-file-p'."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-this-file-p bookmark-alist))
(defun bmkp-url-alist-only ()
"`bookmark-alist', filtered to retain only URL bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-url-bookmark-p bookmark-alist))
(defun bmkp-url-browse-alist-only ()
"`bookmark-alist', filtered to retain only non-W3M URL bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-url-browse-bookmark-p bookmark-alist))
(defun bmkp-variable-list-alist-only ()
"`bookmark-alist', filtered to retain only variable-list bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-variable-list-bookmark-p bookmark-alist))
(defun bmkp-w3m-alist-only ()
"`bookmark-alist', filtered to retain only W3M bookmarks.
A new list is returned (no side effects)."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-w3m-bookmark-p bookmark-alist))
(defun bmkp-marked-bookmarks-only ()
"Return the list of marked bookmarks."
(bookmark-maybe-load-default-file)
(bmkp-remove-if-not #'bmkp-marked-bookmark-p bookmark-alist))
(defun bmkp-unmarked-bookmarks-only ()
"Return the list of unmarked bookmarks."
(bookmark-maybe-load-default-file)
(bmkp-remove-if #'bmkp-marked-bookmark-p bookmark-alist))
(defun bmkp-some-marked-p (alist)
"Return non-nil if ALIST is nonempty and includes a marked bookmark."
(catch 'break (dolist (i alist) (and (bmkp-marked-bookmark-p i) (throw 'break t)))))
(defun bmkp-some-unmarked-p (alist)
"Return non-nil if ALIST is nonempty and includes an unmarked bookmark."
(catch 'break (dolist (i alist) (and (not (bmkp-marked-bookmark-p i)) (throw 'break t)))))
(when (and (fboundp 'cl-puthash) (not (fboundp 'puthash)))
(defalias 'puthash 'cl-puthash))
(if (fboundp 'puthash)
(defun bmkp-remove-dups (sequence &optional test)
"Copy of SEQUENCE with duplicate elements removed.
Optional arg TEST is the test function. If nil, test with `equal'.
See `make-hash-table' for possible values of TEST."
(setq test (or test #'equal))
(let ((htable (make-hash-table :test test)))
(loop for elt in sequence
unless (gethash elt htable)
do (puthash elt elt htable)
finally return (loop for i being the hash-values in htable collect i))))
(defun bmkp-remove-dups (list &optional use-eq)
"Copy of LIST with duplicate elements removed.
Test using `equal' by default, or `eq' if optional USE-EQ is non-nil."
(let ((tail list)
new)
(while tail
(unless (if use-eq (memq (car tail) new) (member (car tail) new))
(push (car tail) new))
(pop tail))
(nreverse new))))
(defun bmkp-delete-bookmark-name-from-list (delname bnames)
"Delete names that represent the same bookmark as DELNAME from BNAMES.
This means that they are `string=' and they either have no property
`bmkp-full-record' or that property has the same value.
Return the modified list BNAMES."
(let ((delprop (get-text-property 0 'bmkp-full-record delname))
bmkprop)
(if (not delprop)
(setq bnames (delete delname bnames))
(while (and bnames (string= delname (car bnames))
(or (not (setq bmkprop (get-text-property 0 'bmkp-full-record (car bnames))))
(equal delprop bmkprop)))
(setq bnames (cdr bnames)))
(let ((tail bnames)
tail-cdr)
(while (setq tail-cdr (cdr tail))
(if (and (car tail-cdr)
(string= delname (car tail-cdr))
(or (not (setq bmkprop (get-text-property 0 'bmkp-full-record (car tail-cdr))))
(equal delprop bmkprop)))
(setcdr tail (cdr tail-cdr))
(setq tail tail-cdr))))
bnames)))
(defun bmkp-bookmark-name-member (name names)
"Like `member', but tests also bookmark NAME's `bmkp-full-record' property.
Return the tail of NAMES whose car is NAME with the property match.
If NAME has no `bmkp-full-record' property then this is just `member'.
If NAME has property `bmkp-full-record', then test whether both:
a. NAME is a member of NAMES and
b. NAME has the same `bmkp-full-record' value as an element of NAMES."
(let ((prop (get-text-property 0 'bmkp-full-record name)))
(if (or (null name) (not prop))
(member name names)
(while (and names (not (and (stringp (car names))
(string= name (car names))
(or (not (get-text-property 0 'bmkp-full-record (car names)))
(equal prop (get-text-property 0 'bmkp-full-record (car names)))))))
(setq names (cdr names)))
names)))
(defun bmkp-names-same-bookmark-p (name1 name2)
"Return non-nil if the two strings name the same bookmark.
The strings are `string=' and their `bmkp-full-record' property values
for the first character are `equal'."
(and (string= name1 name2)
(equal (get-text-property 0 'bmkp-full-record name1)
(get-text-property 0 'bmkp-full-record name2))))
(defun bmkp-remove-if (pred xs)
"A copy of list XS with no elements that satisfy predicate PRED."
(let ((result ()))
(dolist (x xs) (unless (funcall pred x) (push x result)))
(nreverse result)))
(defun bmkp-remove-if-not (pred xs)
"A copy of list XS with only elements that satisfy predicate PRED."
(let ((result ()))
(dolist (x xs) (when (funcall pred x) (push x result)))
(nreverse result)))
(defun bmkp-every (predicate list)
"Return t if PREDICATE is true for all elements of LIST
(while (and list (funcall predicate (car list))) (setq list (cdr list)))
(null list))
(defun bmkp-some (predicate list)
"Return non-nil if PREDICATE is true for some element of LIST
Return the first non-nil value returned by PREDICATE."
(let ((res nil))
(while (and list (not (setq res (funcall predicate (pop list))))))
res))
(defun bmkp-set-union (list1 list2)
"Combine LIST1 and LIST2 using a set-union operation.
The result list contains all items that appear in either LIST1 or
LIST2. Comparison is done using `equal'. This is a non-destructive
function
(cond ((null list1) list2)
((null list2) list1)
((equal list1 list2) list1)
(t
(unless (>= (length list1) (length list2))
(setq list1 (prog1 list2 (setq list2 list1))))
(while list2
(unless (member (car list2) list1) (setq list1 (cons (car list2) list1)))
(setq list2 (cdr list2)))
list1)))
(defun bmkp-upcase (string)
"`upcase', but in case of error, return original STRING.
This works around an Emacs 20 problem that occurs if STRING contains
binary data (weird chars)."
(condition-case nil (upcase string) (error string)))
(defun bmkp-same-file-p (file1 file2)
"Return non-nil if FILE1 and FILE2 name the same file.
If either name is not absolute, then it is expanded relative to
`default-directory' for the test."
(let* ((remote1 (bmkp-file-remote-p file1))
(remote2 (bmkp-file-remote-p file2))
(ignore-case-p (and (not remote1) (not remote2)
(if (boundp 'read-file-name-completion-ignore-case)
(eval (car (get 'read-file-name-completion-ignore-case
'standard-value)))
(memq system-type '(ms-dos windows-nt darwin cygwin))))))
(and (equal remote1 remote2)
(if (fboundp 'file-equal-p)
(file-equal-p file1 file2)
(let ((ft1 (file-truename (expand-file-name file1)))
(ft2 (file-truename (expand-file-name file2))))
(eq t (compare-strings ft1 0 (length ft1) ft2 0 (length ft2) ignore-case-p)))))))
(defun bmkp-file-remote-p (file)
"Test whether FILE specifies a location on a remote system.
Return nil or a string identifying the remote connection (ideally a
prefix of FILE).
A file is considered remote if accessing it is likely to be slower or
less reliable than accessing local files.
This is `file-remote-p', if that function is available. If not, use a
simple match against rough remote file syntax: `/...:'.
Unless `file-remote-p' is available and FILE has a `file-remote-p'
handler that opens a remote connection, `bmkp-file-remote-p' does not
open a remote connection."
(if (fboundp 'file-remote-p)
(file-remote-p file)
(and (stringp file) (string-match "\\`/[^/]+:" file)
(match-string 0 file))))
(defun bmkp-float-time (&optional specified-time)
"Same as `float-time'. (Needed for Emacs 20.)"
(if (fboundp 'float-time)
(float-time specified-time)
(unless specified-time (setq specified-time (current-time)))
(+ (* (float (nth 0 specified-time)) (expt 2 16)) (nth 1 specified-time))))
(defun bmkp-string-less-case-fold-p (s1 s2)
"Like `string-lessp', but respect `case-fold-search'."
(when case-fold-search (setq s1 (bmkp-upcase s1)
s2 (bmkp-upcase s2)))
(string-lessp s1 s2))
(defun 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)))))
(defun bmkp-repeat-command (command)
"Repeat COMMAND."
(let ((repeat-message-function 'ignore))
(setq last-repeatable-command command)
(repeat nil)))
(defun bmkp-get-buffer-name (bookmark)
"Return the `buffer-name' value for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(bookmark-prop-get bookmark 'buffer-name))
(defun bmkp-get-end-position (bookmark)
"Return the `end-position' value for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(bookmark-prop-get bookmark 'end-position))
(defun bmkp-get-visits-count (bookmark)
"Return the `visits' count for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(bookmark-prop-get bookmark 'visits))
(defun bmkp-get-visit-time (bookmark)
"Return the `time' value for BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record."
(let ((vt (bookmark-prop-get bookmark 'time)))
(when (numberp vt)
(setq vt (if (boundp 'seconds-to-time)
(seconds-to-time vt)
(list (floor vt 65536)
(floor (mod vt 65536))
(floor (* (- vt (ffloor vt)) 1000000))))))
vt))
(defun bmkp-sort-omit (alist &optional omit)
"Sort a copy of ALIST, omitting any elements whose keys are in OMIT.
Return the copy.
Do not sort if `bmkp-sort-comparer' is nil.
This is a non-destructive operation: ALIST is not modified.
Sorting is done using using `bmkp-sort-comparer'.
If `bmkp-reverse-sort-p' is non-nil, then reverse the sort order.
Keys are compared for sorting using `equal'.
If optional arg OMIT is non-nil, then it is a list of keys. Omit from
the return value any elements with keys in the list."
(lexical-let ((new-alist (bmkp-remove-omitted alist omit))
(sort-fn (and bmkp-sort-comparer (if (and (not (functionp bmkp-sort-comparer))
(consp bmkp-sort-comparer))
'bmkp-multi-sort
bmkp-sort-comparer))))
(when sort-fn
(setq new-alist (sort new-alist (if bmkp-reverse-sort-p
(lambda (a b) (not (funcall sort-fn a b)))
sort-fn))))
new-alist))
(defun bmkp-remove-omitted (alist &optional omit)
"Copy of bookmark ALIST without bookmarks whose names are in list OMIT.
Name comparison is done using `bmkp-bookmark-name-member'.
If optional arg OMIT is non-nil, then omit from the return value any
elements with keys in list OMIT."
(let ((new ()))
(dolist (ii alist) (unless (bmkp-bookmark-name-member (car ii) omit) (push ii new)))
(nreverse new)))
(defun bmkp-multi-sort (b1 b2)
"Try predicates in `bmkp-sort-comparer', in order, until one decides.
See the description of `bmkp-sort-comparer'.
If `bmkp-reverse-multi-sort-p' is non-nil, then reverse the order for
using multi-sorting predicates."
(let ((preds (car bmkp-sort-comparer))
(final-pred (cadr bmkp-sort-comparer))
(result nil))
(when bmkp-reverse-multi-sort-p (setq preds (reverse preds)))
(catch 'bmkp-multi-sort
(dolist (pred preds)
(setq result (funcall pred b1 b2))
(when (consp result)
(when bmkp-reverse-multi-sort-p (setq result (list (not (car result)))))
(throw 'bmkp-multi-sort (car result))))
(and final-pred (if bmkp-reverse-multi-sort-p
(not (funcall final-pred b1 b2))
(funcall final-pred b1 b2))))))
(defun bmkp-sorting-description (order)
"Return a string describing sort ORDER."
(concat
(if (and order bmkp-sort-comparer)
order
(concat (and order (format "(%s) " order)) "turned OFF"))
(cond ((not bmkp-sort-comparer) nil)
((not (and (consp bmkp-sort-comparer) (consp (car bmkp-sort-comparer))))
(if bmkp-reverse-sort-p " (REVERSED)" ""))
((not (cadr (car bmkp-sort-comparer)))
(if (or (and bmkp-reverse-sort-p (not bmkp-reverse-multi-sort-p))
(and bmkp-reverse-multi-sort-p (not bmkp-reverse-sort-p)))
" (REVERSED)"
"")
)
((and bmkp-reverse-sort-p (not bmkp-reverse-multi-sort-p)) " (REVERSED)")
((and bmkp-reverse-multi-sort-p (not bmkp-reverse-sort-p)) " (each pred group reversed)")
((and bmkp-reverse-multi-sort-p bmkp-reverse-sort-p) " (order of pred groups reversed)")
(t ""))))
(defun bmkp-msg-about-sort-order (order &optional prefix-msg suffix-msg)
"Display a message mentioning sort ORDER and direction.
Optional arg PREFIX-MSG is prepended to the constructed message, and
terminated with a period.
Similarly, SUFFIX-MSG is appended, after appending \". \"."
(let ((msg (concat "Sorting " (bmkp-sorting-description order))))
(when prefix-msg (setq msg (concat prefix-msg ". " msg)))
(when suffix-msg (setq msg (concat msg ". " suffix-msg)))
(message msg)))
(defun bmkp-current-sort-order ()
"Current sort order or sort function, as a string, or nil if none."
(car (rassoc bmkp-sort-comparer bmkp-sort-orders-alist)))
(defun bmkp-flagged-cp (b1 b2)
"True if bookmark B1 is flagged for deletion and bookmark B2 is not.
Return nil if incomparable as described.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((m1 (bmkp-flagged-bookmark-p b1))
(m2 (bmkp-flagged-bookmark-p b2)))
(cond ((and m1 m2) nil)
(m1 '(t))
(m2 '(nil))
(t nil))))
(defun bmkp-marked-cp (b1 b2)
"True if bookmark B1 is marked and bookmark B2 is not.
Return nil if incomparable as described.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((m1 (bmkp-marked-bookmark-p b1))
(m2 (bmkp-marked-bookmark-p b2)))
(cond ((and m1 m2) nil)
(m1 '(t))
(m2 '(nil))
(t nil))))
(defun bmkp-modified-cp (b1 b2)
"True if bookmark B1 is modified and bookmark B2 is not.
Return nil if incomparable as described.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((m1 (bmkp-modified-bookmark-p b1))
(m2 (bmkp-modified-bookmark-p b2)))
(cond ((and m1 m2) nil)
(m1 '(t))
(m2 '(nil))
(t nil))))
(defun bmkp-tagged-cp (b1 b2)
"True if bookmark B1 is tagged and bookmark B2 is not.
Return nil if incomparable as described.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((m1 (bmkp-tagged-bookmark-p b1))
(m2 (bmkp-tagged-bookmark-p b2)))
(cond ((and m1 m2) nil)
(m1 '(t))
(m2 '(nil))
(t nil))))
(defun bmkp-visited-more-cp (b1 b2)
"True if bookmark B1 was visited more often than B2.
Return nil if incomparable as described.
True also if B1 was visited but B2 was not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((v1 (bmkp-get-visits-count b1))
(v2 (bmkp-get-visits-count b2)))
(cond ((and v1 v2)
(cond ((> v1 v2) '(t))
((> v2 v1) '(nil))
(t nil)))
(v1 '(t))
(v2 '(nil))
(t nil))))
(defun bmkp-bookmark-creation-cp (b1 b2)
"True if bookmark B1 was created more recently than B2.
Return nil if incomparable as described.
True also if B1 has a `created' entry but B2 has none.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((t1 (bookmark-prop-get b1 'created))
(t2 (bookmark-prop-get b2 'created)))
(cond ((and t1 t2)
(setq t1 (bmkp-float-time t1)
t2 (bmkp-float-time t2))
(cond ((> t1 t2) '(t))
((> t2 t1) '(nil))
(t nil)))
(t1 '(t))
(t2 '(nil))
(t nil))))
(defun bmkp-same-creation-time-p (b1 b2)
"Return non-nil if `B1 and B2 have same `created' entry.
If neither has a `created' entry (vanilla bookmarks), then return
non-nil if the full bookmarks are `equal'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(let ((time1 (bookmark-prop-get b1 'created))
(time2 (bookmark-prop-get b2 'created)))
(if (or time1 time2)
(equal time1 time2)
(equal b1 b2))))
(defun bmkp-bookmark-last-access-cp (b1 b2)
"True if bookmark B1 was visited more recently than B2.
Return nil if incomparable as described.
True also if B1 was visited but B2 was not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((t1 (bmkp-get-visit-time b1))
(t2 (bmkp-get-visit-time b2)))
(cond ((and t1 t2)
(setq t1 (bmkp-float-time t1)
t2 (bmkp-float-time t2))
(cond ((> t1 t2) '(t))
((> t2 t1) '(nil))
(t nil)))
(t1 '(t))
(t2 '(nil))
(t nil))))
(defun bmkp-buffer-last-access-cp (b1 b2)
"True if bookmark B1's buffer or file was visited more recently than B2's.
Return nil if incomparable as described.
A bookmark to an existing buffer sorts before a file bookmark, even if
the buffer has not been visited during this session.
True also if B1 has a buffer but B2 does not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((buf1 (bmkp-get-buffer-name b1))
(buf2 (bmkp-get-buffer-name b2))
f1 f2 t1 t2)
(setq buf1 (and buf1 (get-buffer buf1))
buf2 (and buf2 (get-buffer buf2)))
(cond ((and buf1 buf2)
(when buf1 (setq buf1 (member buf1 (buffer-list))
buf1 (length buf1)))
(when buf2 (setq buf2 (member buf2 (buffer-list))
buf2 (length buf2)))
(cond ((and buf1 buf2)
(cond ((< buf1 buf2) '(t))
((< buf2 buf1) '(nil))
(t nil)))
(buf1 '(t))
(buf2 '(nil))
(t nil)))
(buf1 '(t))
(buf2 '(nil))
(t nil))))
(defun bmkp-handler-cp (b1 b2)
"True if bookmark B1's handler name sorts alphabetically before B2's.
Return nil if neither sorts before the other.
Two bookmarks with handlers are compared alphabetically, by their
handler-function names, respecting `case-fold-search'.
True also if B1 has a handler but B2 has not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((h1 (bookmark-get-handler b1))
(h2 (bookmark-get-handler b2)))
(cond ((and h1 h2 (symbolp h1) (symbolp h2))
(when (eq h1 'bmkp-jump-woman) (setq h1 'bmkp-jump-man))
(when (eq h2 'bmkp-jump-woman) (setq h2 'bmkp-jump-man))
(setq h1 (symbol-name h1)
h2 (symbol-name h2))
(when case-fold-search (setq h1 (bmkp-upcase h1)
h2 (bmkp-upcase h2)))
(cond ((string-lessp h1 h2) '(t))
((string-lessp h2 h1) '(nil))
(t nil)))
(h1 '(t))
(h2 '(nil))
(t nil))))
(defun bmkp-info-cp (b1 b2)
"True if bookmark B1 sorts as an Info bookmark before B2.
Return nil if neither sorts before the other.
Two Info bookmarks are compared first by file name (corresponding to
the manual), then by node name, then by position.
True also if B1 is an Info bookmark but B2 is not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((i1 (bmkp-info-bookmark-p b1))
(i2 (bmkp-info-bookmark-p b2)))
(cond ((and i1 i2)
(setq i1 (abbreviate-file-name (bookmark-get-filename b1))
i2 (abbreviate-file-name (bookmark-get-filename b2)))
(when case-fold-search (setq i1 (bmkp-upcase i1)
i2 (bmkp-upcase i2)))
(cond ((string-lessp i1 i2) '(t))
((string-lessp i2 i1) '(nil))
(t
(setq i1 (bookmark-prop-get b1 'info-node)
i2 (bookmark-prop-get b2 'info-node))
(cond ((string-lessp i1 i2) '(t))
((string-lessp i2 i1) '(nil))
(t
(setq i1 (bookmark-get-position b1)
i2 (bookmark-get-position b2))
(cond ((or (not i1) (not i2)) '(t))
((<= i1 i2) '(t))
((< i2 i1) '(nil))))))))
(i1 '(t))
(i2 '(nil))
(t nil))))
(defun bmkp-gnus-cp (b1 b2)
"True if bookmark B1 sorts as a Gnus bookmark before B2.
Return nil if neither sorts before the other.
Two Gnus bookmarks are compared first by Gnus group name, then by
article number, then by message ID.
True also if B1 is a Gnus bookmark but B2 is not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((g1 (bmkp-gnus-bookmark-p b1))
(g2 (bmkp-gnus-bookmark-p b2)))
(cond ((and g1 g2)
(setq g1 (bookmark-prop-get b1 'group)
g2 (bookmark-prop-get b2 'group))
(cond ((string-lessp g1 g2) '(t))
((string-lessp g2 g1) '(nil))
(t
(setq g1 (bookmark-prop-get b1 'article)
g2 (bookmark-prop-get b2 'article))
(cond ((< g1 g2) '(t))
((< g2 g1) '(nil))
(t
(setq g1 (bookmark-prop-get b1 'message-id)
g2 (bookmark-prop-get b2 'message-id))
(cond ((string-lessp g1 g2) '(t))
((string-lessp g2 g1) '(nil))
(t nil)))))))
(g1 '(t))
(g2 '(nil))
(t nil))))
(defun bmkp-url-cp (b1 b2)
"True if bookmark B1 sorts as a URL bookmark before B2.
Return nil if neither sorts before the other.
Two URL bookmarks are compared alphabetically, by their URLs.
True also if B1 is a URL bookmark but B2 is not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((u1 (bmkp-url-bookmark-p b1))
(u2 (bmkp-url-bookmark-p b2)))
(cond ((and u1 u2)
(setq u1 (or (bookmark-prop-get b1 'location) (bookmark-get-filename b1))
u2 (or (bookmark-prop-get b2 'location) (bookmark-get-filename b2)))
(cond ((string-lessp u1 u2) '(t))
((string-lessp u2 u1) '(nil))
(t nil)))
(u1 '(t))
(u2 '(nil))
(t nil))))
(defun bmkp-w3m-cp (b1 b2)
"True if bookmark B1 sorts as a W3M URL bookmark before B2.
Return nil if neither sorts before the other.
Two W3M URL bookmarks are compared alphabetically, by their URLs.
True also if B1 is a W3M bookmark but B2 is not.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((w1 (bmkp-w3m-bookmark-p b1))
(w2 (bmkp-w3m-bookmark-p b2)))
(cond ((and w1 w2)
(setq w1 (bookmark-get-filename b1)
w2 (bookmark-get-filename b2))
(cond ((string-lessp w1 w2) '(t))
((string-lessp w2 w1) '(nil))
(t nil)))
(w1 '(t))
(w2 '(nil))
(t nil))))
(defun bmkp-position-cp (b1 b2)
"True if the `position' of B1 is not greater than that of B2.
Return nil if B1 and B2 do not bookmark the same buffer or they have
the same `position' value.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((buf1 (bmkp-get-buffer-name b1))
(buf2 (bmkp-get-buffer-name b2)))
(and buf1 buf2 (equal buf1 buf2)
(let ((i1 (bookmark-get-position b1))
(i2 (bookmark-get-position b2)))
(cond ((or (not i1) (not i2)) '(t))
((<= i1 i2) '(t))
((< i2 i1) '(nil)))))))
(defun bmkp-alpha-cp (b1 b2)
"True if bookmark B1's name sorts alphabetically before B2's.
Return nil if neither sorts before the other.
The bookmark names are compared, respecting `case-fold-search'.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((s1 (car b1))
(s2 (car b2)))
(when case-fold-search (setq s1 (bmkp-upcase s1)
s2 (bmkp-upcase s2)))
(cond ((string-lessp s1 s2) '(t))
((string-lessp s2 s1) '(nil))
(t nil))))
(defun bmkp-alpha-p (b1 b2)
"True if bookmark B1's name sorts alphabetically before B2's.
The bookmark names are compared, respecting `case-fold-search'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(car (bmkp-alpha-cp b1 b2)))
(defun bmkp-file-alpha-cp (b1 b2)
"True if bookmark B1's file name sorts alphabetically before B2's.
Return nil if neither sorts before the other.
The file names are shortened using `abbreviate-file-name', then they
are compared respecting `case-fold-search'.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(let ((f1 (bmkp-file-bookmark-p b1))
(f2 (bmkp-file-bookmark-p b2)))
(cond ((and f1 f2)
(setq f1 (abbreviate-file-name (bookmark-get-filename b1))
f2 (abbreviate-file-name (bookmark-get-filename b2)))
(when case-fold-search (setq f1 (bmkp-upcase f1)
f2 (bmkp-upcase f2)))
(cond ((string-lessp f1 f2) '(t))
((string-lessp f2 f1) '(nil))
(t nil)))
(f1 '(t))
(f2 '(nil))
(t nil))))
(bmkp-define-file-sort-predicate 0)
(bmkp-define-file-sort-predicate 1)
(bmkp-define-file-sort-predicate 2)
(bmkp-define-file-sort-predicate 3)
(bmkp-define-file-sort-predicate 4)
(bmkp-define-file-sort-predicate 5)
(bmkp-define-file-sort-predicate 6)
(bmkp-define-file-sort-predicate 7)
(bmkp-define-file-sort-predicate 8)
(bmkp-define-file-sort-predicate 9)
(bmkp-define-file-sort-predicate 10)
(bmkp-define-file-sort-predicate 11)
(defun bmkp-local-file-accessed-more-recently-cp (b1 b2)
"True if bookmark B1's local file was accessed more recently than B2's.
Return nil if neither sorts before the other.
A local file sorts before a remote file, which sorts before other
bookmarks. Two remote files are considered incomparable - their
access times are not examined.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(cond ((and (bmkp-local-file-bookmark-p b1) (bmkp-local-file-bookmark-p b2))
(bmkp-cp-not (bmkp-file-attribute-4-cp b1 b2)))
((bmkp-local-file-bookmark-p b1) '(t))
((bmkp-local-file-bookmark-p b2) '(nil))
((and (bmkp-remote-file-bookmark-p b1)
(bmkp-remote-file-bookmark-p b2)) nil)
((bmkp-remote-file-bookmark-p b1) '(t))
((bmkp-remote-file-bookmark-p b2) '(nil))
(t nil)))
(defun bmkp-local-file-updated-more-recently-cp (b1 b2)
"True if bookmark B1's local file was updated more recently than B2's.
Return nil if neither sorts before the other.
A local file sorts before a remote file, which sorts before other
bookmarks. Two remote files are considered incomparable - their
update times are not examined.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(cond ((and (bmkp-local-file-bookmark-p b1) (bmkp-local-file-bookmark-p b2))
(bmkp-cp-not (bmkp-file-attribute-5-cp b1 b2)))
((bmkp-local-file-bookmark-p b1) '(t))
((bmkp-local-file-bookmark-p b2) '(nil))
((and (bmkp-remote-file-bookmark-p b1)
(bmkp-remote-file-bookmark-p b2)) nil)
((bmkp-remote-file-bookmark-p b1) '(t))
((bmkp-remote-file-bookmark-p b2) '(nil))
(t nil)))
(defun bmkp-local-file-size-cp (b1 b2)
"True if bookmark B1's local file is larger than B2's.
Return nil if neither sorts before the other.
A local file sorts before a remote file, which sorts before other
bookmarks. Two remote files are considered incomparable - their
sizes are not examined.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(cond ((and (bmkp-local-file-bookmark-p b1) (bmkp-local-file-bookmark-p b2))
(bmkp-cp-not (bmkp-file-attribute-7-cp b1 b2)))
((bmkp-local-file-bookmark-p b1) '(t))
((bmkp-local-file-bookmark-p b2) '(nil))
((and (bmkp-remote-file-bookmark-p b1)
(bmkp-remote-file-bookmark-p b2)) nil)
((bmkp-remote-file-bookmark-p b1) '(t))
((bmkp-remote-file-bookmark-p b2) '(nil))
(t nil)))
(defun bmkp-local-file-type-cp (b1 b2)
"True if bookmark B1 sorts by local file type before B2.
Return nil if neither sorts before the other.
For two local files, a file sorts before a symlink, which sorts before
a directory.
A local file sorts before a remote file, which sorts before other
bookmarks. Two remote files are considered incomparable - their file
types are not examined.
Reverse the roles of B1 and B2 for a false value.
A true value is returned as `(t)', a false value as `(nil)'.
B1 and B2 are full bookmarks (records) or bookmark names.
If either is a record then it need not belong to `bookmark-alist'."
(setq b1 (bookmark-get-bookmark b1)
b2 (bookmark-get-bookmark b2))
(cond ((and (bmkp-local-file-bookmark-p b1) (bmkp-local-file-bookmark-p b2))
(bmkp-file-attribute-0-cp b1 b2))
((bmkp-local-file-bookmark-p b1) '(t))
((bmkp-local-file-bookmark-p b2) '(nil))
((and (bmkp-remote-file-bookmark-p b1)
(bmkp-remote-file-bookmark-p b2)) nil)
((bmkp-remote-file-bookmark-p b1) '(t))
((bmkp-remote-file-bookmark-p b2) '(nil))
(t nil)))
(defun bmkp-cp-not (truth)
"Return the negation of boolean value TRUTH.
If TRUTH is (t), return (nil), and vice versa.
If TRUTH is nil, return nil."
(and truth (if (car truth) '(nil) '(t))))
(defun bmkp-url-target-set (url &optional prefix-only-p name/prefix no-update-p msg-p)
"Set a bookmark for a URL. Return the bookmark.
Interactively you are prompted for the URL. Completion is available.
Use `M-n' to pick up the url at point as the default.
You are also prompted for the bookmark name. But with a prefix arg,
you are prompted only for a bookmark-name prefix. In that case, the
bookmark name is the prefix followed by the URL.
When entering a bookmark name you can use completion against existing
names. This completion is lax, so you can easily edit an existing
name. See `bookmark-set' for particular keys available during this
input.
Non-interactively:
* Non-nil PREFIX-ONLY-P means NAME/PREFIX is a bookmark-name prefix.
* NAME/PREFIX is the bookmark name or its prefix (the suffix = URL).
* Non-nil NO-UPDATE-P means do not refresh/rebuild the bookmark-list
display.
* Non-nil MSG-P means display a status message."
(interactive
(list (if (require 'ffap nil t)
(ffap-read-file-or-url "URL: " (or (bmkp-thing-at-point 'url)
(and (fboundp 'url-get-url-at-point)
(url-get-url-at-point))))
(let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "URL: " nil (or (bmkp-thing-at-point 'url)
(and (fboundp 'url-get-url-at-point)
(url-get-url-at-point))))))
current-prefix-arg
(if current-prefix-arg
(read-string "Prefix for bookmark name: ")
(bmkp-completing-read-lax "Bookmark name"))
nil
'MSG))
(unless name/prefix (setq name/prefix ""))
(lexical-let* ((ul url)
(bookmark-make-record-function (if (eq major-mode 'w3m-mode)
'bmkp-make-w3m-record
(lambda () (bmkp-make-url-browse-record ul))))
bmk failure)
(condition-case err
(setq bmk (bookmark-store (if prefix-only-p (concat name/prefix url) name/prefix)
(cdr (bookmark-make-record)) nil no-update-p (not msg-p)))
(error (setq failure err)))
(when failure (error "Failed to create bookmark for `%s':\n%s\n" url failure))
bmk))
(defun bmkp-file-target-set (file &optional prefix-only-p name/prefix no-overwrite no-update-p msg-p)
"Set a bookmark for FILE. Return the bookmark.
The bookmarked position is the beginning of the file.
Interactively you are prompted for FILE. Completion is available.
You can use `M-n' to pick up the file name at point, or if none then
the visited file.
You are also prompted for the bookmark name. But with a prefix arg,
you are prompted only for a bookmark-name prefix. In that case, the
bookmark name is the prefix followed by the non-directory part of
FILE.
When entering a bookmark name you can use completion against existing
names. This completion is lax, so you can easily edit an existing
name. See `bookmark-set' for particular keys available during this
input.
Non-interactively:
- Non-nil optional arg PREFIX-ONLY-P means prompt for a name prefix.
- Optional arg NAME/PREFIX is the name or name prefix string.
- Optional arg NO-OVERWRITE is passed to `bookmark-store': non-nil
means do not overwrite an existing bookmark that has the same name.
- Non-nil NO-UPDATE-P means do not refresh/rebuild the bookmark-list
display.
- Non-nil optional arg MSG-P means show a warning message if file
does not exist."
(interactive
(list (let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "File: " nil
(or (if (boundp 'file-name-at-point-functions)
(run-hook-with-args-until-success 'file-name-at-point-functions)
(ffap-guesser))
(bmkp-thing-at-point 'filename)
(buffer-file-name))))
current-prefix-arg
(if current-prefix-arg
(read-string "Prefix for bookmark name: ")
(bmkp-completing-read-lax "Bookmark name"))
nil
nil
'MSG))
(unless name/prefix (setq name/prefix ""))
(let ((bookmark-make-record-function (bmkp-make-record-for-target-file file))
bmk failure)
(condition-case err
(setq bmk (bookmark-store (if prefix-only-p
(concat name/prefix (file-name-nondirectory file))
name/prefix)
(cdr (bookmark-make-record)) no-overwrite no-update-p (not msg-p)))
(error (setq failure (error-message-string err))))
(when failure (error "Failed to create bookmark for `%s':\n%s\n" file failure))
(unless no-update-p (bmkp-refresh/rebuild-menu-list bmk (not msg-p)))
(when (and msg-p (not (file-exists-p file)))
(message "File name is now bookmarked, but no such file yet: `%s'" (expand-file-name file)))
bmk))
(defun bmkp-make-record-for-target-file (file)
"Return a function that creates a bookmark record for FILE.
The bookmarked position will be the beginning of the file."
(set-text-properties 0 (length file) () file)
(let ((default-handler (condition-case nil (bmkp-default-handler-for-file file) (error nil)))
(common `((filename . ,file)
(position . 0)
(created . ,(current-time)))))
(cond (default-handler
`(lambda () ',(append common `((file-handler . ,default-handler)))))
((and (require 'image nil t) (require 'image-mode nil t)
(condition-case nil (image-type file) (error nil)))
`(lambda ()
',(append common `((image-type . ,(image-type file)) (handler . image-bookmark-jump)))))
((let ((case-fold-search t)) (bmkp-string-match-p "\\([.]au$\\|[.]wav$\\)" file))
`(lambda () ',(append common '((file-handler . play-sound-file)))))
(t
`(lambda () ',common)))))
(when (fboundp 'file-cache-add-file)
(defadvice file-cache-add-file (around bmkp-autofile-filecache activate)
"Respect option `bmkp-autofile-filecache'."
(case bmkp-autofile-filecache
(autofile-only (bmkp-autofile-set (ad-get-arg 0) nil nil 'NO-UPDATE-P))
(autofile+cache (progn ad-do-it (bmkp-autofile-set (ad-get-arg 0) nil nil 'NO-UPDATE-P 'MSG-P)))
(cache-only ad-do-it))))
(defalias 'bmkp-bookmark-a-file 'bmkp-autofile-set)
(defun bmkp-autofile-set (file &optional dir prefix no-update-p msg-p)
"Set a bookmark for FILE, autonaming the bookmark for the file.
Return the bookmark.
Interactively, you are prompted for FILE. You can use `M-n' to pick
up the file name at point or the visited file.
The bookmark name is the non-directory part of FILE, but with a prefix
arg you are also prompted for a PREFIX string to prepend to the
bookmark name. The bookmarked position is the beginning of the file.
Note that if you provide PREFIX then the bookmark will not satisfy
`bmkp-autofile-bookmark-p' unless you provide the same PREFIX to that
predicate.
The bookmark's file name is FILE if absolute. If relative then it is
FILE expanded in DIR, if non-nil, or in the current directory
\(`default-directory').
If a bookmark with the same name already exists for the same file name
then do nothing.
Otherwise, create a new bookmark for the file, even if a bookmark with
the same name already exists. This means that you can have more than
one autofile bookmark with the same bookmark name and the same
relative file name (non-directory part), but with different absolute
file names.
Non-interactively:
- Non-nil NO-UPDATE-P means do not refresh/rebuild the bookmark-list
display.
- Non-nil optional arg MSG-P means display status messages."
(interactive
(list (let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "File: " nil
(if (or (> emacs-major-version 23)
(and (= emacs-major-version 23) (> emacs-minor-version 1)))
(let ((deflts ())
def)
(when (setq def (buffer-file-name)) (push def deflts))
(when (setq def (bmkp-thing-at-point 'filename)) (push def deflts))
(when (setq def (ffap-guesser)) (push def deflts))
(when (and (boundp 'file-name-at-point-functions)
(setq def (run-hook-with-args-until-success
'file-name-at-point-functions)))
(push def deflts))
deflts)
(or (if (boundp 'file-name-at-point-functions)
(run-hook-with-args-until-success 'file-name-at-point-functions)
(ffap-guesser))
(bmkp-thing-at-point 'filename)
(buffer-file-name)))))
nil
(and current-prefix-arg (read-string "Prefix for bookmark name: "))
nil
'MSG))
(let* ((dir-to-use (if (file-name-absolute-p file)
(file-name-directory file)
(or dir default-directory)))
(bmk (bmkp-get-autofile-bookmark file dir-to-use prefix)))
(if (not bmk)
(bmkp-file-target-set (expand-file-name file dir-to-use) t prefix 'NO-OVERWRITE no-update-p msg-p)
(when msg-p (message "Autofile bookmark set for `%s'" file))
bmk)))
(defun bmkp-get-autofile-bookmark (file &optional dir prefix)
"Return an existing autofile bookmark for FILE, or nil if there is none.
The bookmark name is the non-directory part of FILE, but if PREFIX is
non-nil then it is PREFIX prepended to the non-directory part of FILE.
The directory part of property `filename' is the directory part of
FILE, if FILE is absolute. Otherwise, it is DIR, if non-nil, or
`default-directory' otherwise.
FILE and the `filename' property of the bookmark returned are the
same, except possibly for their directory parts (see previous)."
(let* ((fname (file-name-nondirectory file))
(bname (if prefix (concat prefix fname) fname))
(dir-to-use (if (file-name-absolute-p file)
(file-name-directory file)
(or dir default-directory))))
(catch 'bmkp-get-autofile-bookmark
(dolist (bmk bookmark-alist)
(when (string= bname (bmkp-bookmark-name-from-record bmk))
(let* ((bfil (bookmark-get-filename bmk))
(bdir (and bfil (file-name-directory bfil))))
(when (and bfil
(bmkp-same-file-p fname (file-name-nondirectory bfil))
(bmkp-same-file-p bdir dir-to-use))
(throw 'bmkp-get-autofile-bookmark bmk)))))
nil)))
(defalias 'bmkp-tag-a-file 'bmkp-autofile-add-tags)
(defun bmkp-autofile-add-tags (file tags &optional dir prefix no-update-p msg-p)
"Add TAGS to the autofile bookmark for FILE.
Return the number of tags added.
If there is no autofile bookmark for FILE, create one.
Interactively, you are prompted for FILE and then TAGS.
When prompted for FILE you can use `M-n' to pick up the file name at
point, or if none then the visited file.
With a non-negative prefix argument, you are prompted for a file-name
prefix, as in `bmkp-autofile-set'.
When prompted for tags, hit `RET' to enter each tag, then hit `RET'
again after the last tag. You can use completion to enter each tag.
Completion is lax: you are not limited to existing tags.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a non-positive prefix argument if you want to refresh them.
Non-interactively:
- TAGS is a list of strings.
- DIR, PREFIX, and NO-UPDATE-P are as for `bmkp-autofile-set'.
- Non-nil MSG-P means display a message about the addition."
(interactive
(list (let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "File: " nil
(or (if (boundp 'file-name-at-point-functions)
(run-hook-with-args-until-success 'file-name-at-point-functions)
(ffap-guesser))
(bmkp-thing-at-point 'filename)
(buffer-file-name))))
(bmkp-read-tags-completing nil nil (and current-prefix-arg
(< (prefix-numeric-value current-prefix-arg) 1)))
nil
(and current-prefix-arg (wholenump (prefix-numeric-value current-prefix-arg))
(read-string "Prefix for bookmark name: "))
nil
'MSG))
(bmkp-add-tags (bmkp-autofile-set file dir prefix no-update-p) tags no-update-p msg-p))
(defalias 'bmkp-untag-a-file 'bmkp-autofile-remove-tags)
(defun bmkp-autofile-remove-tags (file tags &optional dir prefix no-update-p msg-p)
"Remove TAGS from autofile bookmark for FILE.
Return the number of tags removed.
Interactively, you are prompted for TAGS and then FILE.
With Emacs 22 and later, only files with at least one of the given
tags are candidates.
When prompted for FILE you can use `M-n' to pick up the file name at
point, or if none then the visited file.
With a non-negative prefix argument, you are prompted for a file-name
prefix, as in `bmkp-autofile-set'.
When prompted for tags, hit `RET' to enter each tag to be removed,
then hit `RET' again after the last tag. You can use completion to
enter each tag.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a non-positive prefix argument if you want to refresh them.
Non-interactively:
- TAGS is a list of strings.
- DIR, PREFIX, and NO-UPDATE-P are as for `bmkp-autofile-set'.
- Non-nil MSG-P means display a message about the removal."
(interactive
(lexical-let* ((pref
(and current-prefix-arg (wholenump (prefix-numeric-value current-prefix-arg))
(read-string "Prefix for bookmark name: ")))
(tgs
(bmkp-read-tags-completing nil nil (and current-prefix-arg (< (prefix-numeric-value
current-prefix-arg) 1))))
(icicle-unpropertize-completion-result-flag t)
(fil (condition-case nil
(read-file-name
"File: " nil
(or (if (boundp 'file-name-at-point-functions)
(run-hook-with-args-until-success 'file-name-at-point-functions)
(ffap-guesser))
(bmkp-thing-at-point 'filename)
(buffer-file-name))
t nil (lambda (ff)
(let* ((bmk (bmkp-get-autofile-bookmark ff nil pref))
(btgs (and bmk (bmkp-get-tags bmk))))
(and btgs (catch 'bmkp-autofile-remove-tags-pred
(dolist (tag tgs)
(when (not (member tag btgs))
(throw 'bmkp-autofile-remove-tags-pred nil)))
t)))))
(error (read-file-name "File: " nil (or (ffap-guesser)
(bmkp-thing-at-point 'filename)
(buffer-file-name)))))))
(list fil tgs nil pref nil 'MSG)))
(bmkp-remove-tags (bmkp-autofile-set file dir prefix no-update-p) tags no-update-p msg-p))
(defun bmkp-purge-notags-autofiles (&optional prefix msg-p)
"Delete all autofile bookmarks that have no tags.
With a prefix arg, you are prompted for a PREFIX for the bookmark name.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (if (not (y-or-n-p "Delete all autofile bookmarks that do not have tags? "))
(error "OK - deletion canceled")
(list (and current-prefix-arg (read-string "Prefix for bookmark name: ")) 'MSG)))
(let ((bmks (bmkp-autofile-alist-only prefix))
(bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag))
record tags)
(dolist (bmk bmks)
(when (and (setq tags (assq 'tags (bmkp-bookmark-data-from-record bmk)))
(or (not tags) (null (cdr tags))))
(bookmark-delete bmk 'BATCHP))))
(bmkp-tags-list)
(bmkp-refresh/rebuild-menu-list nil (not msg-p)))
(defun bmkp-replace-existing-bookmark (bookmark)
"Replace existing BOOKMARK with a new one of the same name.
Return the new bookmark.
BOOKMARK is a full bookmark record, not a bookmark name.
This replaces the existing bookmark data with the data for a new
bookmark, based on `bookmark-make-record-function'. It also updates
the `bmkp-full-record' on the bookmark name (without otherwise
changing the name)."
(let (failure)
(condition-case err
(progn
(setcdr bookmark (cdr (bookmark-make-record)))
(bmkp-maybe-save-bookmarks)
(let ((bname (bmkp-bookmark-name-from-record bookmark)))
(put-text-property 0 (length bname) 'bmkp-full-record bookmark bname)
(unless (memq bookmark bmkp-modified-bookmarks)
(setq bmkp-modified-bookmarks (cons bookmark bmkp-modified-bookmarks)))
(setq bookmark-current-bookmark bname))
(bookmark-bmenu-surreptitiously-rebuild-list 'NO-MSG-P))
(error (setq failure (error-message-string err))))
(if (not failure)
bookmark
(error "Failed to update bookmark `%s':\n%s\n"
(bmkp-bookmark-name-from-record bookmark) failure))))
(defun bmkp-default-handler-for-file (filename)
"Return a default bookmark handler for FILENAME, or nil.
If non-nil, it is a Lisp function, determined as follows:
1. Match FILENAME against `bmkp-default-handlers-for-file-types'. If
it matches a Lisp function, return that function. If it matches a
shell command, return a Lisp function that invokes that shell command.
2. If no match is found and `bmkp-guess-default-handler-for-file-flag'
is non-nil, then try to find an appropriate shell command using, in
order, `dired-guess-default' and `mailcap-file-default-commands'
\(Emacs 23+ only). If a match is found then return a Lisp function
that invokes that shell command."
(let* ((bmkp-user (bmkp-default-handler-user filename))
(shell-cmd (if (stringp bmkp-user)
bmkp-user
(and (not bmkp-user)
bmkp-guess-default-handler-for-file-flag
(or (and (require 'dired-x nil t)
(let* ((case-fold-search
(or (and (boundp 'dired-guess-shell-case-fold-search)
dired-guess-shell-case-fold-search)
case-fold-search))
(default (dired-guess-default (list filename))))
(if (consp default) (car default) default)))
(and (require 'mailcap nil t)
(car (mailcap-file-default-commands (list filename)))))))))
(cond ((stringp shell-cmd) `(lambda (bmk) (dired-do-shell-command ',shell-cmd nil ',(list filename))))
((or (functionp bmkp-user) (and bmkp-user (symbolp bmkp-user)))
bmkp-user)
(t nil))))
(defun bmkp-default-handler-user (filename)
"Return default handler for FILENAME.
The value is based on `bmkp-default-handlers-for-file-types'."
(catch 'bmkp-default-handler-user
(dolist (assn bmkp-default-handlers-for-file-types)
(when (bmkp-string-match-p (car assn) filename) (throw 'bmkp-default-handler-user (cdr assn))))
nil))
(defun bmkp-sound-jump (bookmark)
"Handler for sound files: play the sound file that is BOOKMARK's file.
This is deprecated. It is kept only for old bookmarks that already
use this as the `handler' property. New sound bookmarks use
`play-sound-file' as property `file-handler'."
(play-sound-file (bookmark-get-filename bookmark)))
(when (> emacs-major-version 21)
(defun bmkp-compilation-target-set (&optional prefix)
"Set a bookmark at the start of the line for this compilation hit.
You are prompted for the bookmark name. But with a prefix arg, you
are prompted only for a PREFIX string. In that case, and in Lisp
code, the bookmark name is PREFIX followed by the (relative) file name
of the hit, followed by the line number of the hit."
(interactive "P")
(let* ((file+line (bmkp-compilation-file+line-at (line-beginning-position)))
(file (car file+line))
(line (cdr file+line)))
(unless (and file line) (error "Cursor is not on a compilation hit"))
(save-excursion
(with-current-buffer (find-file-noselect file)
(goto-char (point-min)) (forward-line (1- line))
(if (not prefix)
(call-interactively #'bookmark-set)
(when (interactive-p)
(setq prefix (read-string "Prefix for bookmark name: ")))
(unless (stringp prefix) (setq prefix ""))
(bookmark-set (format "%s%s, line %s" prefix (file-name-nondirectory file) line)
99 'INTERACTIVEP))))))
(defun bmkp-compilation-file+line-at (&optional pos)
"Return the file and position indicated by this compilation message.
These are returned as a cons: (FILE . POSITION).
POSITION is the beginning of the line indicated by the message."
(unless pos (setq pos (point)))
(let* ((loc (car (get-text-property pos 'message)))
(line (cadr loc))
(filename (caar (nth 2 loc)))
(directory (cadr (car (nth 2 loc))))
(spec-dir (if directory (expand-file-name directory) default-directory)))
(cons (expand-file-name filename spec-dir) line))))
(when (> emacs-major-version 21)
(defun bmkp-compilation-target-set-all (prefix &optional msg-p)
"Set a bookmark for each hit of a compilation buffer.
NOTE: You can use `C-x C-q' to make the buffer writable and then
remove any hits that you do not want to bookmark. Only the hits
remaining in the buffer are bookmarked.
Interactively, you are prompted for a PREFIX string to prepend to each
bookmark name, the rest of which is the file name of the hit followed
by its line number.
Non-interactively, non-nil optional arg MSG-P means prompt and display
status messages."
(interactive (list (read-string "Prefix for bookmark name: ") 'MSG))
(when (and msg-p (not (y-or-n-p "This will bookmark *EACH* hit in the buffer. Continue? ")))
(error "OK - canceled"))
(let ((count 0))
(save-excursion
(goto-char (point-min))
(when (get-text-property (point) 'message)
(condition-case nil
(bmkp-compilation-target-set prefix)
(error nil))
(setq count (1+ count)))
(while (and (condition-case nil (progn (compilation-next-error 1) t) (error nil))
(not (eobp)))
(condition-case nil
(bmkp-compilation-target-set prefix)
(error nil))
(setq count (1+ count)))
(when msg-p (message "Set %d bookmarks" count))))))
(when (> emacs-major-version 21)
(defun bmkp-occur-target-set (&optional prefix)
"Set a bookmark at the start of the line for this `(multi-)occur' hit.
You are prompted for the bookmark name. But with a prefix arg, you
are prompted only for a PREFIX string. In that case, and in Lisp
code, the bookmark name is PREFIX followed by the buffer name of the
hit, followed by the line number of the hit.
You can use this only in `Occur' mode (commands such as `occur' and
`multi-occur')."
(interactive "P")
(unless (eq major-mode 'occur-mode) (error "You must be in `occur-mode'"))
(let* ((line (and prefix
(save-excursion
(forward-line 0)
(re-search-forward "^\\s-+\\([0-9]+\\):" (line-end-position) 'NOERROR)
(or (format "%5d" (string-to-number (match-string 1))) ""))))
(mkr (occur-mode-find-occurrence))
(buf (marker-buffer mkr))
(file (or (buffer-file-name buf) bmkp-non-file-filename)))
(save-excursion (with-current-buffer buf
(goto-char mkr)
(if (not prefix)
(call-interactively #'bookmark-set)
(when (interactive-p)
(setq prefix (read-string "Prefix for bookmark name: ")))
(unless (stringp prefix) (setq prefix ""))
(bookmark-set (format "%s%s, line %s" prefix buf line) 99 'INTERACTIVEP)))))))
(when (> emacs-major-version 21)
(defun bmkp-occur-target-set-all (&optional prefix msg-p)
"Set a bookmark for each hit of a `(multi-)occur' buffer.
NOTE: You can use `C-x C-q' to make the buffer writable and then
remove any hits that you do not want to bookmark. Only the hits
remaining in the buffer are bookmarked.
Interactively, you are prompted for a PREFIX string to prepend to each
bookmark name, the rest of which is the buffer name of the hit
followed by its line number.
You can use this only in `Occur' mode (commands such as `occur' and
`multi-occur').
See also command `bmkp-occur-create-autonamed-bookmarks', which
creates autonamed bookmarks to all `occur' and `multi-occur' hits.
Non-interactively, non-nil MSG-P means prompt and show status
messages."
(interactive (list (read-string "Prefix for bookmark name: ") 'MSG))
(when (and msg-p (not (y-or-n-p "This will bookmark *EACH* hit in the buffer. Continue? ")))
(error "OK - canceled"))
(let ((count 0))
(save-excursion
(goto-char (point-min))
(while (condition-case nil
(progn (occur-next) t)
(error nil))
(condition-case nil
(bmkp-occur-target-set prefix)
(error nil))
(setq count (1+ count)))
(when msg-p (message "Set %d bookmarks" count))))))
(defun bmkp-describe-bookmark (bookmark &optional defn)
"Describe BOOKMARK.
With a prefix argument, show the internal definition of the bookmark.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'.
Starting with Emacs 22, if the file is an image file then:
* Show a thumbnail of the image as well.
* If you have command-line tool `exiftool' installed and in your
`$PATH' or `exec-path', then show EXIF data (metadata) about the
image. See standard Emacs library `image-dired.el' for more
information about `exiftool'"
(interactive (list (bookmark-completing-read "Describe bookmark"
(or (and (fboundp 'bmkp-default-lighted)
(bmkp-default-lighted))
(bmkp-default-bookmark-name)))
current-prefix-arg))
(if defn
(bmkp-describe-bookmark-internals bookmark)
(setq bookmark (bookmark-get-bookmark bookmark))
(help-setup-xref (list #'bmkp-describe-bookmark bookmark) (interactive-p))
(let ((help-text (bmkp-bookmark-description bookmark)))
(with-output-to-temp-buffer "*Help*" (princ help-text))
(with-current-buffer "*Help*"
(save-excursion
(goto-char (point-min))
(when (re-search-forward "@#%&()_IMAGE-HERE_()&%#@\\(.+\\)" nil t)
(let* ((image-file (match-string 1))
(image-string (save-match-data
(apply #'propertize "X"
`(display
,(append (image-dired-get-thumbnail-image image-file)
'(:margin 10))
rear-nonsticky (display)
mouse-face highlight
follow-link t
help-echo "`mouse-2' or `RET': Show full image"
keymap
(keymap
(mouse-2
. (lambda (e) (interactive "e")
(find-file ,image-file)))
(13
. (lambda () (interactive)
(find-file ,image-file))))))))
(buffer-read-only nil))
(replace-match image-string)))))
help-text)))
(defun bmkp-bookmark-description (bookmark &optional no-image)
"Help-text description of BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'.
Starting with Emacs 22 and unless optional arg NO-IMAGE is non-nil, if
the file is an image file then the description includes the following:
* A placeholder for a thumbnail image: \"@#%&()_IMAGE-HERE_()&%#@\"
* EXIF data (metadata) about the image, provided you have command-line
tool `exiftool' installed and in your `$PATH' or `exec-path'. See
standard Emacs library `image-dired.el' for more information about
`exiftool'."
(setq bookmark (bookmark-get-bookmark bookmark))
(let ((bname (bmkp-bookmark-name-from-record bookmark))
(buf (bmkp-get-buffer-name bookmark))
(file (bookmark-get-filename bookmark))
(image-p (bmkp-image-bookmark-p bookmark))
(location (bookmark-prop-get bookmark 'location))
(start (bookmark-get-position bookmark))
(end (bmkp-get-end-position bookmark))
(created (bookmark-prop-get bookmark 'created))
(time (bmkp-get-visit-time bookmark))
(visits (bmkp-get-visits-count bookmark))
(tags (mapcar #'bmkp-tag-name (bmkp-get-tags bookmark)))
(sequence-p (bmkp-sequence-bookmark-p bookmark))
(function-p (bmkp-function-bookmark-p bookmark))
(variable-list-p (bmkp-variable-list-bookmark-p bookmark))
(desktop-p (bmkp-desktop-bookmark-p bookmark))
(bookmark-file-p (bmkp-bookmark-file-bookmark-p bookmark))
(dired-p (bmkp-dired-bookmark-p bookmark))
(gnus-p (bmkp-gnus-bookmark-p bookmark))
(info-p (bmkp-info-bookmark-p bookmark))
(man-p (bmkp-man-bookmark-p bookmark))
(url-p (bmkp-url-bookmark-p bookmark))
(w3m-p (bmkp-w3m-bookmark-p bookmark))
(temp-p (bmkp-temporary-bookmark-p bookmark))
(annot (bookmark-get-annotation bookmark))
no-position-p)
(setq no-position-p (not start))
(when (or sequence-p function-p variable-list-p) (setq no-position-p t))
(let* ((temp-text (if temp-p "TEMPORARY " ""))
(help-text
(concat
(format "%sBookmark `%s'\n%s\n\n" temp-text bname
(make-string (+ 11 (length temp-text) (length bname)) ?-))
(cond (sequence-p (concat "Sequence:\n\t"
(mapconcat (lambda (bname)
(let ((name (copy-sequence bname)))
(set-text-properties 0 (length name) () name)
name))
(bookmark-prop-get bookmark 'sequence)
"\n\t")
"\n"))
(function-p (let ((fn (bookmark-prop-get bookmark 'function)))
(if (symbolp fn)
(format "Function:\t\t%s\n" fn)
(format "Function:\n%s\n"
(pp-to-string
(bookmark-prop-get bookmark 'function))))))
(variable-list-p (format "Variable list:\n%s\n"
(pp-to-string (bookmark-prop-get bookmark 'variables))))
(gnus-p (format "Gnus, group:\t\t%s, article: %s, message-id: %s\n"
(bookmark-prop-get bookmark 'group)
(bookmark-prop-get bookmark 'article)
(bookmark-prop-get bookmark 'message-id)))
(man-p (format "UNIX `man' page for:\t`%s'\n"
(or (bookmark-prop-get bookmark 'man-args)
(bookmark-prop-get bookmark 'buffer-name))))
(info-p (format "Info node:\t\t(%s) %s\n"
(file-name-nondirectory file)
(bookmark-prop-get bookmark 'info-node)))
(w3m-p (format "W3m URL:\t\t%s\n" file))
(url-p (format "URL:\t\t%s\n" location))
(desktop-p (format "Desktop file:\t\t%s\n"
(bookmark-prop-get bookmark 'desktop-file)))
(bookmark-file-p (format "Bookmark file:\t\t%s\n"
(bookmark-prop-get bookmark 'bookmark-file)))
(dired-p (let ((switches (bookmark-prop-get bookmark 'dired-switches))
(marked (length (bookmark-prop-get bookmark 'dired-marked)))
(inserted (length (bookmark-prop-get bookmark 'dired-subdirs)))
(hidden (length (bookmark-prop-get bookmark
'dired-hidden-dirs))))
(format "Dired%s:%s\t\t%s\nMarked:\t\t\t%s\n\
Inserted subdirs:\t%s\nHidden subdirs:\t\t%s\n"
(if switches (format " `%s'" switches) "")
(if switches "" (format "\t"))
(expand-file-name file)
marked inserted hidden)))
((equal file bmkp-non-file-filename)
(format "Buffer:\t\t\t%s\n" (bmkp-get-buffer-name bookmark)))
(file (concat (format "File:\t\t\t%s\n" (file-name-nondirectory file))
(let ((dir (file-name-directory (expand-file-name file))))
(and dir (format "Directory:\t\t%s\n" dir)))))
(t "Unknown\n"))
(unless no-position-p
(if (bmkp-region-bookmark-p bookmark)
(format "Region:\t\t\t%d to %d (%d chars)\n" start end (- end start))
(format "Position:\t\t%d\n" start)))
(and visits (format "Visits:\t\t\t%d\n" visits))
(and time (format "Last visit:\t\t%s\n" (format-time-string "%c" time)))
(and created (format "Creation:\t\t%s\n" (format-time-string "%c" created)))
(and tags (format "Tags:\n \"%s\"\n" (mapconcat #'identity tags "\"\n \"")))
(and annot (format "\nAnnotation:\n%s\n" annot))
(and (not no-image)
(fboundp 'image-file-name-regexp)
(bmkp-string-match-p (image-file-name-regexp) file)
(if (fboundp 'display-graphic-p) (display-graphic-p) window-system)
(require 'image-dired nil t)
(image-dired-get-thumbnail-image file)
(concat "\n@#%&()_IMAGE-HERE_()&%#@" file "\n"))
(and (not no-image)
(fboundp 'image-file-name-regexp)
(bmkp-string-match-p (image-file-name-regexp) file)
(progn (message "Gathering image data...") t)
(condition-case nil
(let ((all (bmkp-all-exif-data (expand-file-name file))))
(concat
(and all (not (zerop (length all)))
(format "\nImage Data (EXIF)\n-----------------\n%s"
all))))
(error nil))))))
help-text)))
(defun bmkp-all-exif-data (file)
"Return all EXIF data from FILE, using command-line tool `exiftool'."
(with-temp-buffer
(delete-region (point-min) (point-max))
(unless (eq 0 (call-process shell-file-name nil t nil shell-command-switch
(format "exiftool -All \"%s\"" file)))
(error "Could not get EXIF data"))
(buffer-substring (point-min) (point-max))))
(defun bmkp-describe-bookmark-internals (bookmark)
"Show the internal definition of the bookmark BOOKMARK.
BOOKMARK is a bookmark name or a bookmark record.
If it is a record then it need not belong to `bookmark-alist'."
(interactive (list (bookmark-completing-read "Describe bookmark" (bmkp-default-bookmark-name))))
(setq bookmark (copy-sequence (bookmark-get-bookmark bookmark)))
(help-setup-xref (list #'bmkp-describe-bookmark-internals bookmark) (interactive-p))
(let* ((bname (copy-sequence (bmkp-bookmark-name-from-record bookmark)))
(IGNORE (set-text-properties 0 (length bname) nil bname))
(bmk (cons bname (bmkp-bookmark-data-from-record bookmark)))
(help-text (format "Bookmark `%s'\n%s\n\n%s" bname (make-string (+ 11 (length bname)) ?-)
(pp-to-string bmk))))
(with-output-to-temp-buffer "*Help*" (princ help-text))
help-text))
(defun bmkp-list-defuns-in-commands-file ()
"List the functions defined in `bmkp-bmenu-commands-file'.
Typically, these are all commands."
(interactive)
(when (and bmkp-bmenu-commands-file (file-readable-p bmkp-bmenu-commands-file))
(let ((fns ())
(buf (let ((enable-local-variables nil))
(find-file-noselect bmkp-bmenu-commands-file))))
(help-setup-xref (list #'bmkp-list-defuns-in-commands-file) (interactive-p))
(with-current-buffer buf
(goto-char (point-min))
(while (not (eobp))
(when (re-search-forward "\\s-*(defun \\([^ \t\n(\"]+\\)[ \t\n(]" nil 'move)
(push (match-string 1) fns)))
(setq fns (nreverse fns)
fns (sort fns 'string-lessp)))
(when (buffer-live-p buf) (kill-buffer buf))
(with-output-to-temp-buffer "*Help*"
(princ "Bookmark Commands You Defined (in `bmkp-bmenu-commands-file')") (terpri)
(princ "------------------------------------------------------------------") (terpri)
(terpri)
(let ((non-dups (bmkp-remove-dups fns)))
(dolist (fn non-dups)
(if (and (fboundp (intern fn)) (fboundp 'help-insert-xref-button))
(with-current-buffer "*Help*"
(goto-char (point-max))
(help-insert-xref-button fn 'help-function (intern fn) (commandp (intern fn))))
(princ fn))
(let ((dups (member fn fns))
(count 0))
(while (equal fn (car dups))
(setq count (1+ count)
dups (cdr dups)))
(when (> count 1) (princ (format " (%d times)" count))))
(terpri)))
(help-make-xrefs (current-buffer)))
fns)))
(defun bmkp-root-or-sudo-logged-p ()
"Return t if the user logged in using Tramp as `root' or `sudo'.
Otherwise, return nil."
(catch 'break
(dolist (ii (mapcar #'buffer-name (buffer-list)))
(when (bmkp-string-match-p "*tramp/\\(su\\|sudo\\) ." ii) (throw 'break t)))))
(defun bmkp-position-post-context (breg)
"Return `bookmark-search-size' chars, starting at position BREG.
Return nil if there are not that many chars.
This is text that follows the bookmark's `position'.
This is used for a non-region bookmark."
(and (>= (- (point-max) breg) bookmark-search-size)
(buffer-substring-no-properties breg (+ breg bookmark-search-size))))
(defun bmkp-position-post-context-region (breg ereg)
"Return the region prefix, at BREG.
Return at most `bmkp-region-search-size' or (- EREG BREG) chars.
This is text that follows the bookmark's `position'.
This is used for a region bookmark."
(buffer-substring-no-properties breg (+ breg (min bmkp-region-search-size (- ereg breg)))))
(defun bmkp-position-pre-context (breg)
"Return `bookmark-search-size' chars that precede BREG.
Return nil if there are not that many chars.
This is text that precedes the bookmark's `position'.
This is used for a non-region bookmark."
(and (>= (- breg (point-min)) bookmark-search-size)
(buffer-substring-no-properties breg (- breg bookmark-search-size))))
(defun bmkp-position-pre-context-region (breg)
"Return the text preceding the region beginning, BREG.
Return at most `bmkp-region-search-size' chars.
This is text that precedes the bookmark's `position'.
This is used for a region bookmark."
(buffer-substring-no-properties (max (- breg bmkp-region-search-size) (point-min)) breg))
(defun bmkp-end-position-pre-context (breg ereg)
"Return the region suffix, ending at EREG.
Return at most `bmkp-region-search-size' or (- EREG BREG) chars.
This is text that precedes the bookmark's `end-position'."
(buffer-substring-no-properties (- ereg (min bmkp-region-search-size (- ereg breg))) ereg))
(defun bmkp-end-position-post-context (ereg)
"Return the text following the region end, EREG.
Return at most `bmkp-region-search-size' chars.
This is text that follows the bookmark's `end-position'."
(buffer-substring-no-properties ereg
(+ ereg (min bmkp-region-search-size (- (point-max) (point))))))
(defun bmkp-position-after-whitespace (position)
"Move forward from POSITION, skipping over whitespace. Return point."
(goto-char position) (skip-chars-forward " \n\t" (point-max)) (point))
(defun bmkp-position-before-whitespace (position)
"Move backward from POSITION, skipping over whitespace. Return point."
(goto-char position) (skip-chars-backward " \n\t" (point-min)) (point))
(defun bmkp-save-new-region-location (bookmark beg end)
"Update and save `bookmark-alist' for BOOKMARK, relocating its region.
Saving happens according to `bookmark-save-flag'.
BOOKMARK is a bookmark record.
BEG and END are the new region limits for BOOKMARK.
Do nothing and return nil if `bmkp-save-new-location-flag' is nil.
Otherwise, return non-nil if region was relocated."
(and bmkp-save-new-location-flag
(y-or-n-p "Region relocated. Do you want to save new region limits? ")
(progn
(bookmark-prop-set bookmark 'front-context-string (bmkp-position-post-context-region
beg end))
(bookmark-prop-set bookmark 'rear-context-string (bmkp-position-pre-context-region beg))
(bookmark-prop-set bookmark 'front-context-region-string (bmkp-end-position-pre-context
beg end))
(bookmark-prop-set bookmark 'rear-context-region-string (bmkp-end-position-post-context end))
(bookmark-prop-set bookmark 'position beg)
(bookmark-prop-set bookmark 'end-position end)
(bmkp-maybe-save-bookmarks)
t)))
(defun bmkp-handle-region-default (bookmark)
"Default function to handle BOOKMARK's region.
BOOKMARK is a bookmark name or a bookmark record.
Relocate the region if necessary, then activate it.
If region was relocated, save it if user confirms saving."
(let* (
(bmk (bookmark-get-bookmark bookmark))
(bor-str (bookmark-get-front-context-string bmk))
(eor-str (bookmark-prop-get bmk 'front-context-region-string))
(br-str (bookmark-get-rear-context-string bmk))
(ar-str (bookmark-prop-get bookmark 'rear-context-region-string))
(pos (bookmark-get-position bmk))
(end-pos (bmkp-get-end-position bmk))
(reg-retrieved-p t)
(reg-relocated-p nil))
(unless (and (string= bor-str (buffer-substring-no-properties
(point) (min (point-max) (+ (point) (length bor-str)))))
(string= eor-str (buffer-substring-no-properties
end-pos (max (point-min) (- end-pos (length bor-str))))))
(let ((beg nil)
(end nil))
(goto-char (point-min))
(if (search-forward eor-str (point-max) t)
(setq end (point))
(unless (search-forward br-str (point-max) t)
(when (search-forward ar-str (point-max) t)
(setq end (match-beginning 0)
end (and end (bmkp-position-before-whitespace end))))))
(unless end (goto-char (point-max)))
(if (search-backward bor-str (point-min) t)
(setq beg (point))
(unless (search-backward ar-str (point-min) t)
(when (search-backward br-str (point-min) t)
(setq beg (match-end 0)
beg (and beg (bmkp-position-after-whitespace beg))))))
(setq reg-retrieved-p (or beg end)
reg-relocated-p reg-retrieved-p
pos (or beg (and end (- end (- end-pos pos))) pos)
end-pos (or end (and beg (+ pos (- end-pos pos))) end-pos))))
(cond (reg-retrieved-p
(goto-char pos)
(push-mark end-pos 'nomsg 'activate)
(setq deactivate-mark nil)
(when bmkp-show-end-of-region
(let ((end-win (save-excursion (forward-line (window-height)) (line-end-position))))
(save-excursion (sit-for 0.6) (exchange-point-and-mark) (sit-for 1))
(when (> end-pos end-win) (recenter 1))))
(if (and reg-relocated-p (bmkp-save-new-region-location bmk pos end-pos))
(message "Saved relocated region (from %d to %d)" pos end-pos)
(message "Region is from %d to %d" pos end-pos)))
(t
(goto-char pos) (forward-line 0)
(message "No region from %d to %d" pos end-pos)))))
(defun bmkp-line-number-at-pos (&optional pos)
"Buffer line number at position POS. Current line number if POS is nil.
Counting starts at (point-min), so any narrowing restriction applies."
(1+ (count-lines (point-min) (save-excursion (when pos (goto-char pos)) (forward-line 0) (point)))))
(defun bmkp-goto-position (bookmark file buf bufname pos forward-str behind-str)
"Go to a bookmark that has no region.
Update the recorded position if `bmkp-save-new-location-flag'.
Arguments are respectively the bookmark, its file, buffer, buffer
name, recorded position, and the context strings for the position."
(if (and file (file-readable-p file) (not (buffer-live-p buf)))
(with-current-buffer (find-file-noselect file) (setq buf (buffer-name)))
(unless (or (and buf (get-buffer buf))
(and bufname (get-buffer bufname) (not (string= buf bufname))))
(signal 'file-error `("Jumping to bookmark" "No such file or directory" ,file))))
(set-buffer (or buf bufname))
(when bmkp-jump-display-function
(save-current-buffer (funcall bmkp-jump-display-function (current-buffer))))
(setq deactivate-mark t)
(raise-frame)
(goto-char pos)
(when (and forward-str (search-forward forward-str (point-max) t))
(goto-char (match-beginning 0)))
(when (and behind-str (search-backward behind-str (point-min) t)) (goto-char (match-end 0)))
(when (and (/= pos (point)) bmkp-save-new-location-flag)
(bookmark-prop-set bookmark 'position (point))
(bookmark-prop-set bookmark 'end-position (point))
(bmkp-maybe-save-bookmarks))
(/= pos (point)))
(defun bmkp-jump-sequence (bookmark)
"Handle a sequence bookmark BOOKMARK.
Handler function for sequence bookmarks.
BOOKMARK is a bookmark name or a bookmark record."
(dolist (bmk (bookmark-prop-get bookmark 'sequence))
(bookmark--jump-via bmk bmkp-sequence-jump-display-function))
(message "Done invoking bookmarks in sequence `%s'"
(if (stringp bookmark) bookmark (bmkp-bookmark-name-from-record bookmark))))
(defun bmkp-jump-function (bookmark)
"Handle a function bookmark BOOKMARK.
Handler function for function bookmarks.
BOOKMARK is a bookmark name or a bookmark record."
(let ((fn (bookmark-prop-get bookmark 'function)))
(cond ((functionp fn) (funcall fn))
((vectorp fn)
(execute-kbd-macro fn current-prefix-arg)))))
(defun bmkp-make-bookmark-list-record ()
"Create and return a bookmark-list bookmark record.
This records the current state of buffer `*Bookmark List*': the sort
order, filter function, regexp pattern, title, and omit list."
(let ((state `((last-sort-comparer . ,bmkp-sort-comparer)
(last-reverse-sort-p . ,bmkp-reverse-sort-p)
(last-reverse-multi-sort-p . ,bmkp-reverse-multi-sort-p)
(last-bmenu-filter-function . ,bmkp-bmenu-filter-function)
(last-bmenu-filter-pattern . ,bmkp-bmenu-filter-pattern)
(last-bmenu-omitted-bookmarks . ,(bmkp-maybe-unpropertize-bookmark-names
bmkp-bmenu-omitted-bookmarks))
(last-bmenu-title . ,bmkp-bmenu-title)
(last-bmenu-toggle-filenames . ,bookmark-bmenu-toggle-filenames))))
`(,@(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT)
(filename . ,bmkp-non-file-filename)
(bookmark-list . ,state)
(handler . bmkp-jump-bookmark-list))))
(add-hook 'bookmark-bmenu-mode-hook
(lambda () (set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-bookmark-list-record)))
(defun bmkp-jump-bookmark-list (bookmark)
"Jump to bookmark-list bookmark BOOKMARK.
Handler function for record returned by
`bmkp-make-bookmark-list-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((state (bookmark-prop-get bookmark 'bookmark-list)))
(setq bmkp-sort-comparer (cdr (assq 'last-sort-comparer state))
bmkp-reverse-sort-p (cdr (assq 'last-reverse-sort-p state))
bmkp-reverse-multi-sort-p (cdr (assq 'last-reverse-multi-sort-p state))
bmkp-bmenu-filter-function (cdr (assq 'last-bmenu-filter-function state))
bmkp-bmenu-filter-pattern (or (cdr (assq 'last-bmenu-filter-pattern state)) "")
bmkp-bmenu-omitted-bookmarks (cdr (assq 'last-bmenu-omitted-bookmarks state))
bmkp-bmenu-title (cdr (assq 'last-bmenu-title state))
bookmark-bmenu-toggle-filenames (cdr (assq 'last-bmenu-toggle-filenames state))))
(let ((bookmark-alist (if bmkp-bmenu-filter-function
(funcall bmkp-bmenu-filter-function)
bookmark-alist)))
(setq bmkp-latest-bookmark-alist bookmark-alist)
(bookmark-bmenu-list 'filteredp)
(when (get-buffer "*Bookmark List*") (pop-to-buffer "*Bookmark List*"))))
(defun bmkp-set-bookmark-file-bookmark (file &optional msg-p)
"Create a bookmark that loads bookmark-file FILE when \"jumped\" to.
You are prompted for the names of the bookmark file and the bookmark.
When entering the bookmark name you can use completion against
existing names. This completion is lax, so you can easily edit an
existing name. See `bookmark-set' for particular keys available
during this input.
Non-interactively, non-nil MSG-P means display a status message."
(interactive
(list (let* ((insert-default-directory t)
(std-default (bmkp-default-bookmark-file))
(default (if (bmkp-same-file-p bmkp-current-bookmark-file bmkp-last-bookmark-file)
(if (bmkp-same-file-p bmkp-current-bookmark-file std-default)
bookmark-default-file
std-default)
bmkp-last-bookmark-file)))
(bmkp-read-bookmark-file-name "Create bookmark to load bookmark file: "
(or (file-name-directory default) "~/")
default
'confirm))
'MSG))
(setq file (expand-file-name file))
(unless (file-readable-p file) (error "Unreadable bookmark file `%s'" file))
(with-current-buffer (let ((enable-local-variables ())) (find-file-noselect file))
(goto-char (point-min))
(condition-case nil
(progn (bookmark-maybe-upgrade-file-format)
(unless (listp (bookmark-alist-from-buffer)) (error "")))
(error (error "Not a valid bookmark file: `%s'" file))))
(let ((bookmark-make-record-function (lexical-let ((ff file))
(lambda () (bmkp-make-bookmark-file-record ff))))
(bookmark-name (bmkp-completing-read-lax "Bookmark-file BOOKMARK name"
file nil nil 'bookmark-history)))
(bookmark-set bookmark-name 99 'INTERACTIVEP))
(when msg-p (message "Set bookmark-file bookmark")))
(defun bmkp-make-bookmark-file-record (bookmark-file)
"Create and return a bookmark-file bookmark record.
Records the BOOKMARK-FILE name.
Adds a handler that tests the prefix arg and loads the bookmark file
either as a replacement for the current bookmark file or as a
supplement to it."
`(,@(bookmark-make-record-default 'no-file 'no-context)
(filename . ,bookmark-file)
(bookmark-file . ,bookmark-file)
(handler . bmkp-jump-bookmark-file)))
(defun bmkp-jump-bookmark-file (bookmark &optional switchp batchp)
"Jump to bookmark-file bookmark BOOKMARK, which loads the bookmark file.
Handler function for record returned by
`bmkp-make-bookmark-file-record'.
BOOKMARK is a bookmark name or a bookmark record.
Non-nil optional arg SWITCHP means overwrite current bookmark list.
Non-nil optional arg BATCHP is passed to `bookmark-load'."
(let ((file (bookmark-prop-get bookmark 'bookmark-file))
(overwritep (and switchp (y-or-n-p "SWITCH to new bookmark file, instead of just adding it? "))))
(bookmark-load file overwritep batchp))
(condition-case nil
(throw 'bookmark--jump-via 'BOOKMARK-FILE-JUMP)
(no-catch nil)))
(defun bmkp-bookmark-file-jump (bookmark-name &optional switchp no-msg)
"Jump to a bookmark-file bookmark, which means load its bookmark file.
With a prefix argument, switch to the new bookmark file.
Otherwise, load it to supplement the current bookmark list."
(interactive
(let ((alist (bmkp-bookmark-file-alist-only)))
(list (bmkp-read-bookmark-for-type "bookmark-file" alist nil nil 'bmkp-bookmark-file-history)
current-prefix-arg)))
(bmkp-jump-bookmark-file bookmark-name switchp no-msg))
(defun bmkp-set-desktop-bookmark (desktop-file)
"Save the desktop as a bookmark.
You are prompted for the desktop-file location and the bookmark name.
The default value for the desktop-file location is the current value
of `desktop-file'. As always, you can use `M-n' to retrieve it.
If you also use library Icicles, then the desktop files of all
existing desktop bookmarks are available during the desktop file-name
completion as proxy candidates. To see them, use `C-M-_' to turn on
the display of proxy candidates."
(interactive
(progn (unless (condition-case nil (require 'desktop nil t) (error nil))
(error "You must have library `desktop.el' to use this command"))
(let ((icicle-proxy-candidates (and (boundp 'icicle-mode) icicle-mode
(mapcar (lambda (bmk)
(bookmark-prop-get
bmk 'desktop-file))
(bmkp-desktop-alist-only))))
(icicle-unpropertize-completion-result-flag t))
(list (read-file-name "Save desktop in file: " nil (if (boundp 'desktop-base-file-name)
desktop-base-file-name
desktop-basefilename))))))
(set-text-properties 0 (length desktop-file) nil desktop-file)
(unless (file-name-absolute-p desktop-file) (setq desktop-file (expand-file-name desktop-file)))
(unless (condition-case nil (require 'desktop nil t) (error nil))
(error "You must have library `desktop.el' to use this command"))
(let ((desktop-basefilename (file-name-nondirectory desktop-file))
(desktop-base-file-name (file-name-nondirectory desktop-file))
(desktop-dir (file-name-directory desktop-file))
(desktop-restore-eager t)
(desktop-globals-to-save (bmkp-remove-if (lambda (elt) (memq elt bmkp-desktop-no-save-vars))
desktop-globals-to-save)))
(if (< emacs-major-version 22)
(desktop-save desktop-dir)
(desktop-save desktop-dir 'RELEASE))
(message "Desktop saved in `%s'" desktop-file)
(let ((bookmark-make-record-function (lexical-let ((df desktop-file))
(lambda () (bmkp-make-desktop-record df)))))
(call-interactively #'bookmark-set))))
(defun bmkp-make-desktop-record (desktop-file)
"Create and return a desktop bookmark record.
DESKTOP-FILE is the absolute file name of the desktop file to use."
`(,@(bookmark-make-record-default 'no-file 'no-context)
(filename . ,bmkp-non-file-filename)
(desktop-file . ,desktop-file)
(handler . bmkp-jump-desktop)))
(defun bmkp-jump-desktop (bookmark)
"Jump to desktop bookmark BOOKMARK.
Handler function for record returned by `bmkp-make-desktop-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((desktop-file (bookmark-prop-get bookmark 'desktop-file)))
(unless (condition-case nil (require 'desktop nil t) (error nil))
(error "You must have library `desktop.el' to use this command"))
(bmkp-desktop-change-dir desktop-file)
(unless (bmkp-desktop-read desktop-file) (error "Could not load desktop file"))))
(defun bmkp-desktop-change-dir (desktop-file)
"Change to desktop saved in DESKTOP-FILE.
Kill the desktop as specified by variables `desktop-save-mode' and
`desktop-save' (starting with Emacs 22).
Clear the desktop and load DESKTOP-FILE DIRNAME."
(interactive (list (let ((icicle-unpropertize-completion-result-flag t))
(read-file-name "Change to desktop file: "))))
(set-text-properties 0 (length desktop-file) nil desktop-file)
(unless (file-name-absolute-p desktop-file) (setq desktop-file (expand-file-name desktop-file)))
(unless (condition-case nil (require 'desktop nil t) (error nil))
(error "You must have library `desktop.el' to use this command"))
(let ((desktop-basefilename (file-name-nondirectory desktop-file))
(desktop-base-file-name (file-name-nondirectory desktop-file))
(desktop-dir (file-name-directory desktop-file))
(desktop-restore-eager t)
(desktop-globals-to-save (bmkp-remove-if (lambda (elt) (memq elt bmkp-desktop-no-save-vars))
desktop-globals-to-save)))
(bmkp-desktop-kill)
(desktop-clear)
(if (< emacs-major-version 22) (desktop-read) (desktop-read desktop-dir))))
(defun bmkp-desktop-kill ()
"If `desktop-save-mode' is non-nil, do what `desktop-save' says to do.
In any case, release the lock on the desktop file.
This function does nothing in Emacs versions prior to Emacs 22."
(when (and (boundp 'desktop-save-mode)
desktop-save-mode
(let ((exists (file-exists-p (desktop-full-file-name))))
(or (eq desktop-save t)
(and exists (memq desktop-save '(ask-if-new if-exists)))
(and (or (memq desktop-save '(ask ask-if-new))
(and exists (eq desktop-save 'ask-if-exists)))
(y-or-n-p "Save current desktop first? ")))))
(condition-case err
(if (< emacs-major-version 22)
(desktop-save desktop-dirname)
(desktop-save desktop-dirname 'RELEASE))
(file-error (unless (yes-or-no-p "Error while saving the desktop. IGNORE? ")
(signal (car err) (cdr err))))))
(when (fboundp 'desktop-release-lock) (desktop-release-lock)))
(defun bmkp-desktop-read (file)
"Load desktop-file FILE, then run `desktop-after-read-hook'.
Return t if FILE was loaded, nil otherwise."
(interactive)
(unless (file-name-absolute-p file) (setq file (expand-file-name file)))
(setq desktop-dirname (file-name-directory file))
(if (not (file-readable-p file))
nil
(let ((desktop-restore-eager t)
(desktop-first-buffer nil)
(desktop-buffer-ok-count 0)
(desktop-buffer-fail-count 0)
(desktop-save nil))
(when (fboundp 'desktop-lazy-abort) (desktop-lazy-abort))
(load file t t t)
(when (boundp 'desktop-file-modtime)
(setq desktop-file-modtime (nth 5 (file-attributes file))))
(mapc 'bury-buffer (nreverse (cdr (memq desktop-first-buffer (nreverse (buffer-list))))))
(switch-to-buffer (car (buffer-list)))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook ())
(run-hooks 'desktop-after-read-hook)
(when (boundp 'desktop-buffer-ok-count)
(message "Desktop: %d buffer%s restored%s%s." desktop-buffer-ok-count
(if (= 1 desktop-buffer-ok-count) "" "s")
(if (< 0 desktop-buffer-fail-count)
(format ", %d failed to restore" desktop-buffer-fail-count)
"")
(if (and (boundp 'desktop-buffer-args-list) desktop-buffer-args-list)
(format ", %d to be restored lazily" (length desktop-buffer-args-list))
"")))
t)))
(defun bmkp-desktop-delete (bookmark-name)
"Delete desktop bookmark BOOKMARK-NAME, and delete its desktop file.
Release the lock file in that desktop's directory.
\(This means that if you currently have locked a different desktop
in the same directory, then you will need to relock it.)"
(interactive (let ((alist (bmkp-desktop-alist-only)))
(list (bmkp-read-bookmark-for-type "desktop" alist nil nil 'bmkp-desktop-history
"Delete "))))
(let ((desktop-file (bookmark-prop-get bookmark-name 'desktop-file)))
(unless desktop-file (error "Not a desktop-bookmark: `%s'" bookmark-name))
(let ((desktop-dir (file-name-directory desktop-file)))
(when (fboundp 'desktop-release-lock) (desktop-release-lock)))
(when (file-exists-p desktop-file) (delete-file desktop-file)))
(bookmark-delete bookmark-name))
(when (boundp 'wide-n-restrictions)
(defun bmkp-set-restrictions-bookmark ()
"Save the ring of restrictions for the current buffer as a bookmark.
You need library `wide-n.el' to use the bookmark created."
(interactive)
(let ((bookmark-make-record-function
(lambda () (bmkp-make-variable-list-record
`((wide-n-restrictions
. ,(mapcar (lambda (x)
(if (eq x 'all)
'all
(let ((beg (car x))
(end (cdr x)))
(cons (if (markerp beg) (marker-position beg) beg)
(if (markerp end) (marker-position end) end)))))
wide-n-restrictions)))))))
(call-interactively #'bookmark-set)
(unless (featurep 'wide-n) (message "Bookmark created, but you need `wide-n.el' to use it")))))
(defun bmkp-wrap-bookmark-with-last-kbd-macro (sequence bookmark &optional arg msgp)
"Return a SEQUENCE bookmark that invokes BOOKMARK plus `last-kbd-macro'.
If bookmark SEQUENCE does not yet exist, create it. Else, update it.
You are prompted for the SEQUENCE and BOOKMARK names.
BOOKMARK can be any kind of bookmark. A special case is when it is a
sequence bookmark:
* If BOOKMARK is the same as SEQUENCE and is an existing sequence
bookmark then it is updated only by appending the keyboard macro to
the sequence.
* If BOOKMARK is a sequence bookmark different from SEQUENCE then
SEQUENCE is updated to invoke the sequence in BOOKMARK plus
`last-kbd-macro' either before or after the other bookmarks of
SEQUENCE, according to the prefix arg, which is passed to
`bmkp-set-sequence-bookmark'."
(interactive (list (bmkp-completing-read-lax "Sequence bookmark" (bmkp-new-bookmark-default-names))
(bmkp-completing-read-lax "Bookmark" (bmkp-new-bookmark-default-names))
current-prefix-arg
'MSGP))
(unless last-kbd-macro (error "No keyboard macro defined"))
(let ((kbd-macro-vec (read-kbd-macro (format-kbd-macro last-kbd-macro) 'VECTOR)))
(bmkp-set-sequence-bookmark sequence (if (equal bookmark sequence)
(list kbd-macro-vec)
(list bookmark kbd-macro-vec))
arg msgp)))
(defun bmkp-set-sequence-bookmark (seqname bookmark-names &optional arg msgp)
"Create or update a sequence bookmark named SEQNAME from BOOKMARK-NAMES.
If a sequence bookmark named SEQNAME does not exist then create one.
Else act on the existing bookmarks in bookmark SEQNAME as follows:
* no prefix arg: Append BOOKMARK-NAMES to those present.
* prefix arg < 0: Replace those present with BOOKMARK-NAMES.
* other prefix arg: Prepend BOOKMARK-NAMES to those present.
You are prompted for SEQNAME and each of the BOOKMARK-NAMES.
When entering each item of BOOKMARK-NAMES you can enter an existing or
future bookmark name, or you can enter the name of a function or a
named keyboard macro (provided what you type does not match a bookmark
name). If a function or keyboard macro, then a function bookmark is
created for it and that bookmark is included in the sequence.
When the sequence bookmark is invoked (\"jumped to\"), its bookmarks
are invoked in order. In particular, any given bookmark is invoked
once for each of its occurrences in the sequence.
From Lisp code:
BOOKMARK-NAMES is generally a list of bookmarks or bookmark names
\(strings).
Each item in BOOKMARK-NAMES can alternatively be one of the
following, in which case a function bookmark is created for it and is
used in the sequence.
* a keyboard macro as a vector
* a function, which includes a lambda form or a symbol whose
function value is a function or a keyboard macro.
If an item in BOOKMARK-NAMES is a sequence bookmark then its
bookmarks are used as if they were items of BOOKMARK-NAMES.
MSGP non-nil means possibly interact with the user, showing messages."
(interactive (list
(if (< (prefix-numeric-value current-prefix-arg) 0)
(bookmark-completing-read "Replace existing sequence bookmark" nil
(bmkp-sequence-alist-only))
(bmkp-completing-read-lax "Create or update sequence bookmark"
(bmkp-new-bookmark-default-names)
(bmkp-sequence-alist-only)))
(bmkp-completing-read-bookmarks nil nil nil 'lax)
current-prefix-arg
'MSGP))
(let* ((seq (bmkp-get-bookmark-in-alist seqname 'NOERROR))
(exists (and seq (bmkp-sequence-bookmark-p seq)))
(replacing t)
(bnames ()))
(dolist (bname bookmark-names)
(cond ((or (functionp (setq fun bname))
(vectorp fun)
(functionp (setq fun (condition-case nil
(read-from-whole-string bname)
(error nil)))))
(let ((fun-bmk-name
(cond ((symbolp fun) (symbol-name fun))
((vectorp fun) (format-kbd-macro fun))
(t (let ((ii 1)
(len (length bname))
(trial (make-string (1+ bmkp-bookmark-name-length-max) 88)))
(while (and (< ii len) (> (length trial) bmkp-bookmark-name-length-max))
(setq trial (make-temp-name (substring bname 0 (- ii)))))
(while (intern-soft
(setq trial (make-temp-name (substring bname 0 (- ii))))))
trial)))))
(push (bmkp-bookmark-name-from-record (bmkp-make-function-bookmark fun-bmk-name fun))
bnames)))
((bmkp-sequence-bookmark-p bname)
(setq bnames (append (reverse (bookmark-prop-get bname 'sequence)) bnames)))
((stringp bname) (push bname bnames))
((bookmark-get-bookmarkp bname 'NOERROR)
(push (bmkp-bookmark-name-from-record bname) bnames))
(t (error "Bad BOOKMARK-NAMES arg to `bmkp-set-sequence-bookmark': `%S'"
bookmark-names))))
(setq bnames (nreverse bnames))
(if (not exists)
(when msgp (message "Creating sequence bookmark..."))
(if (< (prefix-numeric-value arg) 0)
(when msgp (message "REPLACING existing sequence bookmark...") (sit-for 0.5))
(when msgp (message "%sing to sequence bookmark..." (if arg "Prepend" "Append")) (sit-for 0.5))
(setq replacing nil
bnames (if arg
(nconc bnames (bookmark-prop-get seq 'sequence))
(nconc (bookmark-prop-get seq 'sequence) bnames)))))
(let ((bookmark-make-record-function `(lambda () (bmkp-make-sequence-record ',bnames))))
(bookmark-set seqname))
(when msgp (message "Sequence `%s' %s" seqname (if exists
(if replacing "replaced" "updated")
"created")))))
(defun bmkp-make-sequence-record (bookmark-names)
"Create and return a sequence bookmark record.
BOOKMARK-NAMES is a list of names of the bookmarks to be invoked in
sequence."
(let ((record `(,@(bookmark-make-record-default 'no-file 'no-context)
(filename . ,bmkp-non-file-filename)
(sequence . ,bookmark-names)
(handler . bmkp-jump-sequence))))
record))
(defun bmkp-set-variable-list-bookmark (variables)
"Save a list of variables as a bookmark.
Interactively, read the variables to save, using
`bmkp-read-variables-completing'."
(interactive (list (bmkp-read-variables-completing)))
(let ((bookmark-make-record-function (lexical-let ((vars variables))
(lambda () (bmkp-make-variable-list-record vars)))))
(call-interactively #'bookmark-set)))
(defun bmkp-create-variable-list-bookmark (bookmark-name vars vals &optional buffer-name)
"Create a variable-list bookmark named BOOKMARK-NAME from VARS and VALS.
VARS and VALS are corresponding lists of variables and their values.
Optional arg BUFFER-NAME is the buffer name to use for the bookmark (a
string). This is useful if some of the variables are buffer-local.
If BUFFER-NAME is nil, the current buffer name is recorded."
(eval `(multiple-value-bind ,vars ',vals
(let ((bookmark-make-record-function (lexical-let ((vs vars)
(buf buffer-name))
(lambda () (bmkp-make-variable-list-record vs buf)))))
(bookmark-set ,bookmark-name)))))
(defun bmkp-read-variables-completing (&optional option)
"Read variable names with completion, and return them as a list of symbols.
Reads names one by one, until you hit `RET' twice consecutively.
Non-nil argument OPTION means read only user option names."
(bookmark-maybe-load-default-file)
(let ((var (bmkp-read-variable "Variable (RET for each, empty input to finish): " option))
(vars ())
old-var)
(while (not (string= "" var))
(add-to-list 'vars var)
(setq var (bmkp-read-variable "Variable: " option)))
(nreverse vars)))
(defun bmkp-read-variable (prompt &optional option default-value)
"Read name of a variable and return it as a symbol.
Prompt with string PROMPT.
With non-nil OPTION, read the name of a user option.
The default value is DEFAULT-VALUE if non-nil, or the nearest symbol
to the cursor if it is a variable."
(setq option (if option 'user-variable-p 'boundp))
(let ((symb (cond ((fboundp 'symbol-nearest-point)
(symbol-nearest-point))
((fboundp 'symbol-at-point) (symbol-at-point))
(t nil)))
(enable-recursive-minibuffers t)
(icicle-unpropertize-completion-result-flag t))
(when (and default-value (symbolp default-value))
(setq default-value (symbol-name default-value)))
(intern (completing-read prompt obarray option t nil 'minibuffer-history
(or default-value (and (funcall option symb) (symbol-name symb)))
t))))
(defun bmkp-make-variable-list-record (variables &optional buffer-name)
"Create and return a variable-list bookmark record.
VARIABLES is the list of variables to save.
Each entry in VARIABLES is either a variable (a symbol) or a cons
whose car is a variable and whose cdr is the variable's value.
Optional arg BUFFER-NAME is the buffer to use for the bookmark. This
is useful if some of the variables are buffer-local. If BUFFER-NAME
is nil, the current buffer is used."
(let ((record `(,@(bookmark-make-record-default 'no-file 'no-context)
(filename . ,bmkp-non-file-filename)
(variables . ,(or (bmkp-printable-vars+vals variables)
(error "No variables to bookmark")))
(handler . bmkp-jump-variable-list))))
(when buffer-name (let ((bname (assq 'buffer-name record))) (setcdr bname buffer-name)))
record))
(defun bmkp-printable-vars+vals (variables)
"Return an alist of printable VARIABLES paired with their values.
Display a message for any variables that are not printable.
VARIABLES is the list of variables. Each entry in VARIABLES is either
a variable (a symbol) or a cons whose car is a variable and whose cdr
is the variable's value."
(let ((vars+vals ())
(unprintables ()))
(dolist (var variables)
(let ((val (if (consp var) (cdr var) (symbol-value var))))
(if (bmkp-printable-p val)
(add-to-list 'vars+vals (if (consp var) var (cons var val)))
(add-to-list 'unprintables var))))
(when unprintables (message "Unsavable (unreadable) vars: %S" unprintables) (sit-for 3))
vars+vals))
(defun bmkp-printable-p (value)
"Return non-nil if VALUE would be Lisp-readable if printed using `prin1'."
(or (stringp value) (numberp value) (symbolp value)
(with-temp-buffer
(condition-case nil
(let ((print-readably t)
(print-level nil)
(print-circle t))
(prin1 value (current-buffer))
(read (point-min-marker))
t)
(error nil)))))
(defun bmkp-jump-variable-list (bookmark)
"Jump to variable-list bookmark BOOKMARK, restoring the recorded values.
Handler function for record returned by
`bmkp-make-variable-list-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((buf (bmkp-get-buffer-name bookmark))
(vars+vals (bookmark-prop-get bookmark 'variables)))
(unless (get-buffer buf)
(message "Bookmarked for non-existent buffer `%s', so using current buffer" buf) (sit-for 3)
(setq buf (current-buffer)))
(with-current-buffer buf
(dolist (var+val vars+vals)
(set (car var+val) (cdr var+val))))
(message "Variables restored in buffer `%s': %S" buf (mapcar #'car vars+vals))
(sit-for 3)))
(defun bmkp-make-url-browse-record (url)
"Create and return a url bookmark for `browse-url' to visit URL.
The handler is `bmkp-jump-url-browse'."
(require 'browse-url)
(let ((url-0 (copy-sequence url)))
(set-text-properties 0 (length url) () url-0)
`((filename . ,bmkp-non-file-filename)
(location . ,url-0)
(handler . bmkp-jump-url-browse))))
(defun bmkp-jump-url-browse (bookmark)
"Handler function for record returned by `bmkp-make-url-browse-record'.
BOOKMARK is a bookmark name or a bookmark record."
(require 'browse-url)
(let ((url (bookmark-prop-get bookmark 'location)))
(browse-url url)))
(defun bmkp-make-w3m-record ()
"Make a special entry for w3m buffers."
(require 'w3m)
`(,w3m-current-title
,@(bookmark-make-record-default 'no-file)
(filename . ,w3m-current-url)
(handler . bmkp-jump-w3m)))
(add-hook 'w3m-mode-hook (lambda () (set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-w3m-record)))
(defun bmkp-w3m-set-new-buffer-name ()
"Set the w3m buffer name according to the number of w3m buffers already open."
(require 'w3m)
(let ((len (length (w3m-list-buffers 'nosort))))
(if (= len 0) "*w3m*" (format "*w3m*<%d>" (1+ len)))))
(defun bmkp-jump-w3m-new-session (bookmark)
"Jump to W3M bookmark BOOKMARK, setting a new tab."
(require 'w3m)
(let ((buf (bmkp-w3m-set-new-buffer-name)))
(w3m-browse-url (bookmark-prop-get bookmark 'filename) 'newsession)
(while (not (get-buffer buf)) (sit-for 1))
(with-current-buffer buf
(goto-char (point-min))
(while (eq (line-beginning-position) (line-end-position)) (sit-for 1)))
(bookmark-default-handler
`("" (buffer . ,buf) . ,(bmkp-bookmark-data-from-record bookmark)))))
(defun bmkp-jump-w3m-only-one-tab (bookmark)
"Close all W3M sessions and jump to BOOKMARK in a new W3M buffer."
(require 'w3m)
(w3m-quit 'force)
(w3m-browse-url (bookmark-prop-get bookmark 'filename))
(with-current-buffer "*w3m*" (while (eq (point-min) (point-max)) (sit-for 1)))
(bookmark-default-handler
`("" (buffer . ,(buffer-name (current-buffer))) . ,(bmkp-bookmark-data-from-record bookmark))))
(defalias 'bmkext-jump-w3m 'bmkp-jump-w3m)
(defun bmkp-jump-w3m (bookmark)
"Handler function for record returned by `bmkp-make-w3m-record'.
BOOKMARK is a bookmark name or a bookmark record.
Use multi-tabs in W3M if `bmkp-w3m-allow-multi-tabs' is non-nil."
(require 'w3m)
(if bmkp-w3m-allow-multi-tabs
(bmkp-jump-w3m-new-session bookmark)
(bmkp-jump-w3m-only-one-tab bookmark)))
(defun bmkp-make-gnus-record ()
"Make a bookmark entry for a Gnus summary buffer.
Current buffer can be the article buffer or the summary buffer."
(require 'gnus)
(let ((pos nil)
buf)
(unless (and (if (fboundp 'derived-mode-p)
(derived-mode-p 'gnus-summary-mode)
(eq major-mode 'gnus-summary-mode))
gnus-article-current)
(setq buf "art"
bookmark-yank-point (point)
bookmark-current-buffer (current-buffer))
(save-restriction (widen) (setq pos (point)))
(gnus-article-show-summary))
(let* ((grp (car gnus-article-current))
(art (cdr gnus-article-current))
(head (gnus-summary-article-header art))
(id (mail-header-id head)))
(unless buf (setq buf "sum"))
`((elt (gnus-summary-article-header) 1)
,@(condition-case
nil
(bookmark-make-record-default 'NO-FILE 'NO-CONTEXT pos)
(wrong-number-of-arguments (bookmark-make-record-default 'POINT-ONLY)))
(location . ,(format "Gnus-%s %s:%d:%s" buf grp art id))
(filename . ,bmkp-non-file-filename) (group . ,grp) (article . ,art) (message-id . ,id)
(handler . bmkp-jump-gnus)))))
(add-hook 'gnus-summary-mode-hook (lambda ()
(set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-gnus-record)))
(add-hook 'gnus-article-mode-hook (lambda ()
(set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-gnus-record)))
(defun bmkp-jump-gnus (bookmark)
"Handler function for record returned by `bmkp-make-gnus-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let* ((group (bookmark-prop-get bookmark 'group))
(article (bookmark-prop-get bookmark 'article))
(id (bookmark-prop-get bookmark 'message-id))
(loc (bookmark-prop-get bookmark 'location))
(buf (if loc (car (split-string loc)) (bookmark-prop-get bookmark 'buffer))))
(if (< emacs-major-version 22) (gnus-fetch-group group) (gnus-fetch-group group (list article)))
(gnus-summary-insert-cached-articles)
(gnus-summary-goto-article id nil 'force)
(when (equal buf "Gnus-art") (sit-for 1) (other-window 1))
(bookmark-default-handler `("" (buffer . ,buf) . ,(bmkp-bookmark-data-from-record bookmark)))))
(defun bmkext-jump-gnus (bookmark)
"`gnus-summary-bookmark-jump' if defined, else `bmkp-jump-gnus'."
(if (fboundp 'gnus-summary-bookmark-jump)
(gnus-summary-bookmark-jump bookmark)
(bmkp-jump-gnus bookmark)))
(when (> emacs-major-version 20)
(defun bmkp-make-woman-record ()
"Create bookmark record for `man' page bookmark created by `woman'."
`(,@(bookmark-make-record-default 'no-file)
(filename . ,woman-last-file-name) (handler . bmkp-jump-woman)))
(unless (> emacs-major-version 23)
(add-hook 'woman-mode-hook (lambda ()
(set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-woman-record)))))
(defun bmkp-make-man-record ()
"Create bookmark record for `man' page bookmark created by `man'."
`(,@(bookmark-make-record-default 'no-file)
(filename . ,bmkp-non-file-filename)
(man-args . ,Man-arguments) (handler . bmkp-jump-man)))
(unless (> emacs-major-version 23)
(add-hook 'Man-mode-hook (lambda () (set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-man-record))))
(defun bmkext-jump-woman (bookmark)
"`woman-bookmark-jump' if defined, else `bmkp-jump-woman'."
(if (fboundp 'woman-bookmark-jump)
(woman-bookmark-jump bookmark)
(bmkp-jump-woman bookmark)))
(defun bmkp-jump-woman (bookmark)
"Handler function for `man' page bookmark created by `woman'.
BOOKMARK is a bookmark name or a bookmark record."
(unless (> emacs-major-version 20)
(error "`woman' bookmarks are not supported in Emacs prior to Emacs 21"))
(bookmark-default-handler
`("" (buffer . ,(save-window-excursion (woman-find-file (bookmark-get-filename bookmark))
(current-buffer)))
. ,(bmkp-bookmark-data-from-record bookmark))))
(defun bmkext-jump-man (bookmark)
"`Man-bookmark-jump' if defined, else `bmkp-jump-man'."
(if (fboundp 'Man-bookmark-jump)
(Man-bookmark-jump bookmark)
(bmkp-jump-man bookmark)))
(defun bmkp-jump-man (bookmark)
"Handler function for `man' page bookmark created by `man'.
BOOKMARK is a bookmark name or a bookmark record."
(require 'man)
(let ((Man-notify-method
(case bmkp-jump-display-function
((nil display-buffer) 'quiet)
(switch-to-buffer 'pushy)
((bmkp-select-buffer-other-window switch-to-buffer-other-window pop-to-buffer) 'friendly)
(t 'quiet))))
(Man-getpage-in-background (bookmark-prop-get bookmark 'man-args))
(while (get-process "man") (sit-for 0.2))
(bookmark-default-handler (bookmark-get-bookmark bookmark))))
(defun bmkp-dired-remember-*-marks (beg end)
"Return a list of the files and subdirs marked `*' in Dired."
(if selective-display
(let ((inhibit-read-only t)) (subst-char-in-region beg end ?\r ?\n)))
(let ((mfiles ())
fil)
(save-excursion (goto-char beg)
(while (re-search-forward "^\\*" end t)
(when (setq fil (dired-get-filename nil t)) (push fil mfiles))))
(nreverse mfiles)))
(defun bmkp-make-dired-record ()
"Create and return a Dired bookmark record."
(let ((hidden-dirs (save-excursion (dired-remember-hidden))))
(unwind-protect
(let ((dir (expand-file-name (if (consp dired-directory)
(file-name-directory (car dired-directory))
dired-directory)))
(subdirs (bmkp-dired-subdirs))
(mfiles (bmkp-dired-remember-*-marks (point-min) (point-max))))
`(,dir
,@(bookmark-make-record-default 'no-file)
(filename . ,dir) (dired-directory . ,dired-directory)
(dired-marked . ,mfiles) (dired-switches . ,dired-actual-switches)
(dired-subdirs . ,subdirs) (dired-hidden-dirs . ,hidden-dirs)
(handler . bmkp-jump-dired)))
(save-excursion
(dolist (dir hidden-dirs) (when (dired-goto-subdir dir) (dired-hide-subdir 1)))))))
(defun bmkp-dired-subdirs ()
"Alist of inserted subdirectories, without their positions (markers).
This is like `dired-subdir-alist' but without the top-level dir and
without subdir positions (markers)."
(interactive)
(let ((subdir-alist (cdr (reverse dired-subdir-alist)))
(subdirs-wo-posns ()))
(dolist (sub subdir-alist) (push (list (car sub)) subdirs-wo-posns))
subdirs-wo-posns))
(add-hook 'dired-mode-hook (lambda () (set (make-local-variable 'bookmark-make-record-function)
'bmkp-make-dired-record)))
(defun bmkp-jump-dired (bookmark)
"Jump to Dired bookmark BOOKMARK.
Handler function for record returned by `bmkp-make-dired-record'.
BOOKMARK is a bookmark name or a bookmark record."
(let ((dir (bookmark-prop-get bookmark 'dired-directory))
(mfiles (bookmark-prop-get bookmark 'dired-marked))
(switches (bookmark-prop-get bookmark 'dired-switches))
(subdirs (bookmark-prop-get bookmark 'dired-subdirs))
(hidden-dirs (bookmark-prop-get bookmark 'dired-hidden-dirs)))
(case bmkp-jump-display-function
((nil switch-to-buffer display-buffer) (dired dir switches))
((bmkp-select-buffer-other-window pop-to-buffer switch-to-buffer-other-window)
(dired-other-window dir switches))
(t (dired dir switches)))
(let ((inhibit-read-only t))
(dired-insert-old-subdirs subdirs)
(dired-mark-remembered (mapcar (lexical-let ((dd dir))
(lambda (mf) (cons (expand-file-name mf dd) 42)))
mfiles))
(save-excursion (dolist (dir hidden-dirs) (when (dired-goto-subdir dir) (dired-hide-subdir 1)))))
(goto-char (bookmark-get-position bookmark))))
(defun bmkp-read-bookmark-for-type (type alist &optional other-win pred hist action)
"Read the name of a bookmark of type TYPE, with completion.
TYPE is a string used in the prompt: \"Jump to TYPE bookmark: \".
ALIST is the alist used for completion. If nil then raise an error to
let the user know there are no bookmarks of type TYPE.
Non-nil OTHER-WIN means append \" in another window\" to the prompt.
Non-nil PRED is a predicate used for bookmark-name completion.
Non-nil HIST is a history symbol. Default is `bookmark-history'.
ACTION is the action to mention in the prompt. `Jump to ', if nil."
(unless alist (error "No bookmarks of type %s" type))
(bookmark-completing-read (concat (or action "Jump to ") type " bookmark"
(and other-win " in another window"))
(bmkp-default-bookmark-name alist)
alist pred hist))
(defun bmkp-jump-to-type (bookmark-name &optional use-region-p)
"Jump to a bookmark of a given type. You are prompted for the type.
Otherwise, this is the same as `bookmark-jump' - see that, in
particular, for info about using a prefix argument.
When prompted for the type, you can use completion against the known
bookmark types (see `bmkp-types-alist').
Completion is lax, so you can also enter the name of a bookmark
`handler' or `file-handler' function, without completion. Bookmarks
with that property value are then the jump candidates."
(interactive
(let* ((completion-ignore-case t)
(type-cands bmkp-types-alist)
(icicle-unpropertize-completion-result-flag t)
(type (completing-read "Type of bookmark: " type-cands))
(history (assoc-default type type-cands))
(alist (if history
(funcall
(intern (format "bmkp-%s-alist-only" type)))
bookmark-alist))
(bmk-name (bmkp-read-bookmark-for-type
type alist nil
(and (not history)
(bmkp-handler-pred (intern type)))
history)))
(list bmk-name (or (equal type "Region") current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-jump-to-type-other-window (bookmark-name &optional use-region-p)
"`bmkp-jump-to-type', but in another window."
(interactive
(let* ((completion-ignore-case t)
(type-cands bmkp-types-alist)
(icicle-unpropertize-completion-result-flag t)
(type (completing-read "Type of bookmark: " type-cands))
(history (assoc-default type type-cands))
(alist (if history
(funcall
(intern (format "bmkp-%s-alist-only" type)))
bookmark-alist))
(bmk-name (bmkp-read-bookmark-for-type
type alist t
(and (not history)
(bmkp-handler-pred (intern type)))
history)))
(list bmk-name (or (equal type "Region") current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-handler-pred (type)
"Return a bookmark predicate that tests bookmarks with handler TYPE.
More precisely, the predicate returns non-nil if TYPE is either the
bookmark's `handler' or `file-handler' property value."
`(lambda (bmk)
(member ',type `(,(bookmark-prop-get bmk 'file-handler) ,(bookmark-get-handler bmk)))))
(defun bmkp-autonamed-jump (bookmark-name)
"Jump to an autonamed bookmark.
This is a specialization of `bookmark-jump'."
(interactive
(let ((alist (bmkp-autonamed-alist-only)))
(list (bmkp-read-bookmark-for-type "autonamed" alist nil nil 'bmkp-autonamed-history))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer nil))
(defun bmkp-autonamed-jump-other-window (bookmark-name)
"`bmkp-autonamed-jump', but in another window."
(interactive
(let ((alist (bmkp-autonamed-alist-only)))
(list (bmkp-read-bookmark-for-type "autonamed" alist t nil 'bmkp-autonamed-history))))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window nil))
(defun bmkp-autonamed-this-buffer-jump (bookmark-name)
"Jump to an autonamed bookmark in the current buffer.
This is a specialization of `bookmark-jump'."
(interactive
(let ((alist (bmkp-autonamed-this-buffer-alist-only)))
(list (bmkp-read-bookmark-for-type "autonamed" alist nil nil 'bmkp-autonamed-history))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer nil))
(defun bmkp-autonamed-this-buffer-jump-other-window (bookmark-name)
"`bmkp-autonamed-this-buffer-jump', but in another window."
(interactive
(let ((alist (bmkp-autonamed-this-buffer-alist-only)))
(list (bmkp-read-bookmark-for-type "autonamed" alist t nil 'bmkp-autonamed-history))))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window nil))
(defun bmkp-bookmark-list-jump (bookmark-name &optional use-region-p)
"Jump to a bookmark-list bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-bookmark-list-alist-only)))
(list (bmkp-read-bookmark-for-type "bookmark-list" alist nil nil 'bmkp-bookmark-list-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-desktop-jump (bookmark-name &optional use-region-p)
"Jump to a desktop bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-desktop-alist-only)))
(list (bmkp-read-bookmark-for-type "desktop" alist nil nil 'bmkp-desktop-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-dired-jump (bookmark-name &optional use-region-p)
"Jump to a Dired bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-dired-alist-only)))
(list (bmkp-read-bookmark-for-type "Dired" alist nil nil 'bmkp-dired-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-dired-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-dired-jump', but in another window."
(interactive
(let ((alist (bmkp-dired-alist-only)))
(list (bmkp-read-bookmark-for-type "Dired" alist t nil 'bmkp-dired-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-dired-this-dir-jump (bookmark-name &optional use-region-p)
"Jump to a Dired bookmark for the `default-directory'.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-dired-this-dir-alist-only)))
(list (bmkp-read-bookmark-for-type "Dired-for-this-dir " alist nil nil 'bmkp-dired-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-dired-this-dir-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-dired-this-dir-jump', but in another window."
(interactive
(let ((alist (bmkp-dired-this-dir-alist-only)))
(list (bmkp-read-bookmark-for-type "Dired-for-this-dir" alist t nil 'bmkp-dired-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-file-jump (bookmark-name &optional use-region-p)
"Jump to a file or directory bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-file-alist-only)))
(list (bmkp-read-bookmark-for-type "file" alist nil nil 'bmkp-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-file-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-file-jump', but in another window."
(interactive
(let ((alist (bmkp-file-alist-only)))
(list (bmkp-read-bookmark-for-type "file" alist t nil 'bmkp-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-file-this-dir-jump (bookmark-name &optional use-region-p)
"Jump to a bookmark for a file or subdir in the `default-directory'.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-file-this-dir-alist-only)))
(list (bmkp-read-bookmark-for-type "file-in-this-dir" alist nil nil 'bmkp-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-file-this-dir-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-file-this-dir-jump', but in another window."
(interactive
(let ((alist (bmkp-file-this-dir-alist-only)))
(list (bmkp-read-bookmark-for-type "file-in-this-dir" alist t nil 'bmkp-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-gnus-jump (bookmark-name &optional use-region-p)
"Jump to a Gnus bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-gnus-alist-only)))
(list (bmkp-read-bookmark-for-type "Gnus" alist nil nil 'bmkp-gnus-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-gnus-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-gnus-jump', but in another window."
(interactive
(let ((alist (bmkp-gnus-alist-only)))
(list (bmkp-read-bookmark-for-type "Gnus" alist t nil 'bmkp-gnus-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-image-jump (bookmark-name &optional use-region-p)
"Jump to an image-file bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-image-alist-only)))
(list (bmkp-read-bookmark-for-type "image" alist nil nil 'bmkp-image-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-image-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-image-jump', but in another window."
(interactive
(let ((alist (bmkp-image-alist-only)))
(list (bmkp-read-bookmark-for-type "image" alist t nil 'bmkp-image-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-info-jump (bookmark-name &optional use-region-p)
"Jump to an Info bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-info-alist-only)))
(list (bmkp-read-bookmark-for-type "Info" alist nil nil 'bmkp-info-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-info-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-info-jump', but in another window."
(interactive
(let ((alist (bmkp-info-alist-only)))
(list (bmkp-read-bookmark-for-type "Info" alist t nil 'bmkp-info-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-local-file-jump (bookmark-name &optional use-region-p)
"Jump to a local file or directory bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-local-file-alist-only)))
(list (bmkp-read-bookmark-for-type "local file" alist nil nil 'bmkp-local-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-local-file-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-local-file-jump', but in another window."
(interactive
(let ((alist (bmkp-local-file-alist-only)))
(list (bmkp-read-bookmark-for-type "local file" alist t nil 'bmkp-local-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-man-jump (bookmark-name &optional use-region-p)
"Jump to a `man'-page bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-man-alist-only)))
(list (bmkp-read-bookmark-for-type "`man'" alist nil nil 'bmkp-man-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-man-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-man-jump', but in another window."
(interactive
(let ((alist (bmkp-man-alist-only)))
(list (bmkp-read-bookmark-for-type "`man'" alist t nil 'bmkp-man-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-non-file-jump (bookmark-name &optional use-region-p)
"Jump to a non-file (buffer) bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-non-file-alist-only)))
(list (bmkp-read-bookmark-for-type "non-file (buffer)" alist nil nil 'bmkp-non-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-non-file-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-non-file-jump', but in another window."
(interactive
(let ((alist (bmkp-non-file-alist-only)))
(list (bmkp-read-bookmark-for-type "non-file (buffer)" alist t nil 'bmkp-non-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-region-jump (bookmark-name)
"Jump to a region bookmark. Select the region.
This is a specialization of `bookmark-jump', but without a prefix arg."
(interactive (list (bmkp-read-bookmark-for-type "region" (bmkp-region-alist-only) nil nil
'bmkp-region-history)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer t))
(defun bmkp-region-jump-other-window (bookmark-name)
"`bmkp-region-jump', but in another window."
(interactive (list (bmkp-read-bookmark-for-type "region" (bmkp-region-alist-only) t nil
'bmkp-region-history)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window t))
(defun bmkp-remote-file-jump (bookmark-name &optional use-region-p)
"Jump to a remote file or directory bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-remote-file-alist-only)))
(list (bmkp-read-bookmark-for-type "remote file" alist nil nil 'bmkp-remote-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-remote-file-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-remote-file-jump', but in another window."
(interactive
(let ((alist (bmkp-remote-file-alist-only)))
(list (bmkp-read-bookmark-for-type "remote file" alist t nil 'bmkp-remote-file-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-specific-buffers-jump (buffers bookmark-name &optional use-region-p)
"Jump to a bookmark for a buffer in list BUFFERS.
Interactively, read buffer names and bookmark name, with completion.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((buffs ())
buff)
(while (and (setq buff (bmkp-completing-read-buffer-name 'ALLOW-EMPTY)) (not (string= "" buff)))
(add-to-list 'buffs buff))
(let ((alist (bmkp-specific-buffers-alist-only buffs)))
(list buffs (bmkp-read-bookmark-for-type "specific-buffers" alist nil nil 'specific-buffers-history)
current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-specific-buffers-jump-other-window (buffers bookmark-name
&optional use-region-p)
"`bmkp-specific-buffers-jump', but in another window."
(interactive
(let ((buffs ())
buff)
(while (and (setq buff (bmkp-completing-read-buffer-name 'ALLOW-EMPTY)) (not (string= "" buff)))
(add-to-list 'buffs buff))
(let ((alist (bmkp-specific-buffers-alist-only buffs)))
(list buffs (bmkp-read-bookmark-for-type "specific-buffers" alist t nil 'specific-buffers-history)
current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-specific-files-jump (files bookmark-name &optional use-region-p)
"Jump to a bookmark for a file in list FILES.
Interactively, read file names and bookmark name, with completion.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((use-file-dialog nil)
(files ())
file)
(while (and (setq file (bmkp-completing-read-file-name 'ALLOW-EMPTY)) (not (string= "" file)))
(add-to-list 'files file))
(let ((alist (bmkp-specific-files-alist-only files)))
(list files (bmkp-read-bookmark-for-type "specific-files" alist nil nil 'specific-files-history)
current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-specific-files-jump-other-window (files bookmark-name
&optional use-region-p)
"`bmkp-specific-files-jump', but in another window."
(interactive
(let ((use-file-dialog nil)
(files ())
file)
(while (and (setq file (bmkp-completing-read-file-name 'ALLOW-EMPTY)) (not (string= "" file)))
(add-to-list 'files file))
(let ((alist (bmkp-specific-files-alist-only files)))
(list files (bmkp-read-bookmark-for-type "specific-files" alist t nil 'specific-files-history)
current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-temporary-jump (bookmark-name)
"Jump to a temporary bookmark.
This is a specialization of `bookmark-jump', but without a prefix arg."
(interactive (list (bmkp-read-bookmark-for-type "temporary" (bmkp-temporary-alist-only) nil nil
'bmkp-temporary-history)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer t))
(defun bmkp-temporary-jump-other-window (bookmark-name)
"`bmkp-temporary-jump', but in another window."
(interactive (list (bmkp-read-bookmark-for-type "temporary" (bmkp-temporary-alist-only) t nil
'bmkp-temporary-history)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window t))
(defun bmkp-this-buffer-jump (bookmark-name &optional use-region-p)
"Jump to a bookmark for the current buffer.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-this-buffer-alist-only)))
(unless alist (error "No bookmarks for this buffer"))
(list (bookmark-completing-read "Jump to bookmark for this buffer"
(bmkp-default-bookmark-name alist) alist)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-this-buffer-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-this-buffer-jump', but in another window."
(interactive
(let ((alist (bmkp-this-buffer-alist-only)))
(unless alist (error "No bookmarks for this buffer"))
(list (bookmark-completing-read "Jump to bookmark for this buffer in another window"
(bmkp-default-bookmark-name alist) alist)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-variable-list-jump (bookmark-name)
"Jump to a variable-list bookmark.
This is a specialization of `bookmark-jump'."
(interactive
(let ((alist (bmkp-variable-list-alist-only)))
(list (bmkp-read-bookmark-for-type "variable-list" alist nil nil 'bmkp-variable-list-history))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer nil))
(defun bmkp-url-jump (bookmark-name &optional use-region-p)
"Jump to a URL bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (if (fboundp 'w3m-list-buffers)
(bmkp-url-alist-only)
(bmkp-url-browse-alist-only))))
(list (bmkp-read-bookmark-for-type "URL" alist nil nil 'bmkp-url-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-url-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-url-jump', but in another window."
(interactive
(let ((alist (if (fboundp 'w3m-list-buffers)
(bmkp-url-alist-only)
(bmkp-url-browse-alist-only))))
(list (bmkp-read-bookmark-for-type "URL" alist t nil 'bmkp-url-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-w32-browser-jump (bookmark-name)
"Jump to a bookmark whose handler applies `w32-browser' to its file.
This is a specialization of `bookmark-jump'."
(interactive
(list (bmkp-read-bookmark-for-type "w32-browser" bookmark-alist nil
(bmkp-handler-pred 'w32-browser)
'bmkp-w32-browser-history)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer nil))
(defun bmkp-w3m-jump (bookmark-name &optional use-region-p)
"Jump to a W3M bookmark.
This is a specialization of `bookmark-jump' - see that, in particular
for info about using a prefix argument."
(interactive
(let ((alist (bmkp-w3m-alist-only)))
(list (bmkp-read-bookmark-for-type "W3M" alist nil nil 'bmkp-w3m-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-w3m-jump-other-window (bookmark-name &optional use-region-p)
"`bmkp-w3m-jump', but in another window."
(interactive
(let ((alist (bmkp-w3m-alist-only)))
(list (bmkp-read-bookmark-for-type "W3M" alist t nil 'bmkp-w3m-history)
current-prefix-arg)))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-all-tags-jump (tags bookmark)
"Jump to a BOOKMARK that has all of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
If you specify no tags, then every bookmark that has some tags is a
candidate.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-all-tags-alist-only tgs)))
(unless alist (error "No bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-all-tags-jump-other-window (tags bookmark)
"`bmkp-all-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-all-tags-alist-only tgs)))
(unless alist (error "No bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-all-tags-regexp-jump (regexp bookmark)
"Jump to a BOOKMARK that has each tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for all tags: "))
(alist (bmkp-all-tags-regexp-alist-only rgx)))
(unless alist (error "No bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-all-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-all-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for all tags: "))
(alist (bmkp-all-tags-regexp-alist-only rgx)))
(unless alist (error "No bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-some-tags-jump (tags bookmark)
"Jump to a BOOKMARK that has at least one of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-some-tags-jump-other-window (tags bookmark)
"`bmkp-some-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-some-tags-regexp-jump (regexp bookmark)
"Jump to a BOOKMARK that has a tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-some-tags-regexp-alist-only rgx)))
(unless alist (error "No bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-some-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-some-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-some-tags-regexp-alist-only rgx)))
(unless alist (error "No bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-all-tags-jump (tags bookmark)
"Jump to a file or directory BOOKMARK that has all of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
If you specify no tags, then every bookmark that has some tags is a
candidate.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-all-tags-alist-only tgs)))
(unless alist (error "No file or dir bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-all-tags-jump-other-window (tags bookmark)
"`bmkp-file-all-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-all-tags-alist-only tgs)))
(unless alist (error "No file or dir bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-all-tags-regexp-jump (regexp bookmark)
"Jump to a file or directory BOOKMARK that has each tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-all-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-all-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-file-all-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-all-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-some-tags-jump (tags bookmark)
"Jump to a file or directory BOOKMARK that has at least one of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No file or dir bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-some-tags-jump-other-window (tags bookmark)
"`bmkp-file-some-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No file or dir bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-some-tags-regexp-jump (regexp bookmark)
"Jump to a file or directory BOOKMARK that has a tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-some-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-some-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-file-some-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-some-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-this-dir-all-tags-jump (tags bookmark)
"Jump to a file BOOKMARK in this dir that has all of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
If you specify no tags, then every bookmark that has some tags is a
candidate.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-this-dir-all-tags-alist-only tgs)))
(unless alist (error "No file or dir bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-this-dir-all-tags-jump-other-window (tags bookmark)
"`bmkp-file-this-dir-all-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-this-dir-all-tags-alist-only tgs)))
(unless alist (error "No file or dir bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-this-dir-all-tags-regexp-jump (regexp bookmark)
"Jump to a file BOOKMARK in this dir that has each tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-this-dir-all-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-this-dir-all-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-file-this-dir-all-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-this-dir-all-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-this-dir-some-tags-jump (tags bookmark)
"Jump to a file BOOKMARK in this dir that has at least one of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-this-dir-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No file or dir bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-this-dir-some-tags-jump-other-window (tags bookmark)
"`bmkp-file-this-dir-some-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-file-this-dir-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No file or dir bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-file-this-dir-some-tags-regexp-jump (regexp bookmark)
"Jump to a file BOOKMARK in this dir that has a tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-this-dir-some-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-file-this-dir-some-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-file-this-dir-some-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-file-this-dir-some-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-autofile-jump (bookmark-name)
"Jump to an autofile bookmark.
This is a specialization of `bookmark-jump'."
(interactive
(let ((alist (bmkp-autofile-alist-only)))
(list (bmkp-read-bookmark-for-type "autofile" alist nil nil 'bmkp-autofile-history))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer nil))
(defun bmkp-autofile-jump-other-window (bookmark-name)
"`bmkp-autofile-jump' but in another window."
(interactive
(let ((alist (bmkp-autofile-alist-only)))
(list (bmkp-read-bookmark-for-type "autofile" alist t nil 'bmkp-autofile-history))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer nil))
(defun bmkp-autofile-all-tags-jump (tags bookmark)
"Jump to an autofile BOOKMARK in this dir that has all of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
If you specify no tags, then every bookmark that has some tags is a
candidate.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-autofile-all-tags-alist-only tgs)))
(unless alist (error "No file or dir bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-autofile-all-tags-jump-other-window (tags bookmark)
"`bmkp-autofile-all-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-autofile-all-tags-alist-only tgs)))
(unless alist (error "No file or dir bookmarks have all of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-autofile-all-tags-regexp-jump (regexp bookmark)
"Jump to an autofile BOOKMARK in this dir that has each tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-autofile-all-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-autofile-all-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-autofile-all-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-autofile-all-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-autofile-some-tags-jump (tags bookmark)
"Jump to an autofile BOOKMARK in this dir that has at least one of the TAGS.
Hit `RET' to enter each tag, then hit `RET' again after the last tag.
You can use completion to enter the bookmark name and each tag.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-autofile-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No file or dir bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-autofile-some-tags-jump-other-window (tags bookmark)
"`bmkp-autofile-some-tags-jump', but in another window."
(interactive
(let* ((tgs (bmkp-read-tags-completing nil nil current-prefix-arg))
(alist (bmkp-autofile-some-tags-alist-only tgs)))
(unless tgs (error "You did not specify any tags"))
(unless alist (error "No file or dir bookmarks have any of the specified tags"))
(list tgs (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-autofile-some-tags-regexp-jump (regexp bookmark)
"Jump to an autofile BOOKMARK in this dir that has a tag matching REGEXP.
You are prompted for the REGEXP.
Then you are prompted for the BOOKMARK (with completion)."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-autofile-some-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump bookmark))
(defun bmkp-autofile-some-tags-regexp-jump-other-window (regexp bookmark)
"`bmkp-autofile-some-tags-regexp-jump', but in another window."
(interactive
(let* ((rgx (read-string "Regexp for tags: "))
(alist (bmkp-autofile-some-tags-regexp-alist-only rgx)))
(unless alist (error "No file or dir bookmarks have tags that match `%s'" rgx))
(list rgx (bookmark-completing-read "File bookmark" (bmkp-default-bookmark-name alist) alist))))
(bookmark-jump-other-window bookmark))
(defun bmkp-find-file (&optional file create-autofile-p must-exist-p msg-p)
"Visit a file or directory, respecting any associated autofile handlers.
You are prompted for the file or directory name, FILE.
If FILE matches an entry in `bmkp-default-handlers-for-file-types'
then use the associated default handler to access the file.
Otherwise, just use `find-file'.
With a prefix arg, create an autofile bookmark if FILE does not
already have one.
Non-interactively:
* Non-nil MUST-EXIST-P means raise an error if FILE has no autofile
bookmark.
* Non-nil MSG-P means display a status message."
(interactive "i\nP\ni\np")
(let* ((use-file-dialog nil)
(icicle-unpropertize-completion-result-flag t)
(fil (or file (read-file-name "Find file: " nil nil t)))
(dir-to-use (if (file-name-absolute-p fil)
(file-name-directory fil)
default-directory))
(bmk (bmkp-get-autofile-bookmark fil)))
(if bmk
(bookmark-jump bmk)
(when must-exist-p (error "File `%s' is not an autofile (no bookmark)" fil))
(when create-autofile-p
(bmkp-file-target-set (expand-file-name fil dir-to-use) t nil 'NO-OVERWRITE msg-p)
(when msg-p (message "Autofile bookmark set for `%s'" fil)))
(let ((default-handler (condition-case nil (bmkp-default-handler-for-file fil) (error nil))))
(if default-handler (funcall default-handler fil) (find-file fil 'WILDCARDS))))))
(defun bmkp-find-file-other-window (&optional file create-autofile-p must-exist-p msg-p)
"`bmkp-find-file', but in another window."
(interactive "i\nP\ni\np")
(let* ((use-file-dialog nil)
(icicle-unpropertize-completion-result-flag t)
(fil (or file (read-file-name "Find file: " nil nil t)))
(dir-to-use (if (file-name-absolute-p fil)
(file-name-directory fil)
default-directory))
(bmk (bmkp-get-autofile-bookmark fil dir-to-use)))
(if bmk
(bookmark-jump-other-window bmk)
(when must-exist-p (error "File `%s' is not an autofile (no bookmark)" fil))
(when create-autofile-p
(bmkp-file-target-set (expand-file-name fil dir-to-use) t nil 'NO-OVERWRITE msg-p)
(when msg-p (message "Autofile bookmark created for `%s'" fil)))
(let ((default-handler (condition-case nil (bmkp-default-handler-for-file fil) (error nil))))
(if default-handler (funcall default-handler fil) (find-file-other-window fil 'WILDCARDS))))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-all-tags (tags &optional file)
"Visit a file or directory that has all of the TAGS.
You are prompted first for the tags. Hit `RET' to enter each tag,
then hit `RET' again after the last tag. You can use completion to
enter each tag. This completion is lax: you are not limited to
existing tags.
You are then prompted for the file name. This is read using
`read-file-name', so you can browse up and down the file hierarchy.
The completion candidates are file names, not bookmark names.
However, only files that are bookmarked as autofiles are candidates.
If you specify no tags, then every file that has some tags is a
candidate.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive (list (bmkp-read-tags-completing nil nil current-prefix-arg)))
(lexical-let* ((tgs tags)
(use-file-dialog nil)
(pred
(lambda (ff)
(lexical-let* ((bmk (bmkp-get-autofile-bookmark ff))
(btgs (and bmk (bmkp-get-tags bmk))))
(and btgs (bmkp-every (lambda (tag) (bmkp-has-tag-p bmk tag)) tgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(when bmk (bookmark-jump bmk)))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-all-tags-other-window (tags &optional file)
"`bmkp-find-file-all-tags', but in another window."
(interactive (list (bmkp-read-tags-completing nil nil current-prefix-arg)))
(lexical-let* ((tgs tags)
(use-file-dialog nil)
(pred
(lambda (ff)
(lexical-let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-every (lambda (tag) (bmkp-has-tag-p bk tag)) tgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump-other-window bmk))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-all-tags-regexp (regexp &optional file)
"Visit a file or directory that has each tag matching REGEXP.
You are prompted for the REGEXP."
(interactive (list (read-string "Regexp for tags: ")))
(lexical-let* ((rg regexp)
(use-file-dialog nil)
(pred
(lambda (ff)
(let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-every (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
btgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump bmk))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-all-tags-regexp-other-window (regexp &optional file)
"`bmkp-find-file-all-tags-regexp', but in another window."
(interactive (list (read-string "Regexp for tags: ")))
(lexical-let* ((rg regexp)
(use-file-dialog nil)
(pred
(lambda (ff)
(let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-every (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
btgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump-other-window bmk))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-some-tags (tags &optional file)
"Visit a file or directory that has at least one of the TAGS.
You are prompted first for the tags. Hit `RET' to enter each tag,
then hit `RET' again after the last tag. You can use completion to
enter each tag. This completion is lax: you are not limited to
existing tags.
You are then prompted for the file name. This is read using
`read-file-name', so you can browse up and down the file hierarchy.
The completion candidates are file names, not bookmark names.
However, only files that are bookmarked as autofiles are candidates.
By default, the tag choices for completion are NOT refreshed, to save
time. Use a prefix argument if you want to refresh them."
(interactive (list (bmkp-read-tags-completing nil nil current-prefix-arg)))
(lexical-let* ((tgs tags)
(use-file-dialog nil)
(pred
(lambda (ff)
(lexical-let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-some (lambda (tag) (bmkp-has-tag-p bk tag)) tgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump bmk))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-some-tags-other-window (tags &optional file)
"`bmkp-find-file-some-tags', but in another window."
(interactive (list (bmkp-read-tags-completing nil nil current-prefix-arg)))
(lexical-let* ((tgs tags)
(use-file-dialog nil)
(pred
(lambda (ff)
(lexical-let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-some (lambda (tag) (bmkp-has-tag-p bk tag)) tgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump-other-window bmk))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-some-tags-regexp (regexp &optional file)
"Visit a file or directory that has a tag matching REGEXP.
You are prompted for the REGEXP."
(interactive (list (read-string "Regexp for tags: ")))
(lexical-let* ((rg regexp)
(use-file-dialog nil)
(pred
(lambda (ff)
(let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-some (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
btgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump bmk))))
(when (> emacs-major-version 21)
(defun bmkp-find-file-some-tags-regexp-other-window (regexp &optional file)
"`bmkp-find-file-some-tags-regexp', but in another window."
(interactive (list (read-string "Regexp for tags: ")))
(lexical-let* ((rg regexp)
(use-file-dialog nil)
(pred
(lambda (ff)
(let* ((bk (bmkp-get-autofile-bookmark ff))
(btgs (and bk (bmkp-get-tags bk))))
(and btgs (bmkp-some (lambda (tag) (bmkp-string-match-p rg (bmkp-tag-name tag)))
btgs)))))
(icicle-unpropertize-completion-result-flag t)
(icicle-must-pass-after-match-predicate pred)
(fil (or (and file (funcall pred file) file)
(read-file-name
"Find file: " nil nil t nil
(and (or (not (boundp 'icicle-mode))
(not icicle-mode))
pred))))
(bmk (bmkp-get-autofile-bookmark fil)))
(bookmark-jump-other-window bmk))))
(defun bmkp-jump-in-navlist (bookmark-name &optional use-region-p)
"Jump to a bookmark, choosing from those in the navigation list."
(interactive
(progn (unless bmkp-nav-alist
(bookmark-maybe-load-default-file)
(setq bmkp-nav-alist bookmark-alist)
(unless bmkp-nav-alist (error "No bookmarks"))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist))
(message "Bookmark navigation list is now the global bookmark list") (sit-for 2))
(let ((bookmark-alist bmkp-nav-alist))
(list (bookmark-completing-read "Jump to bookmark (in another window)"
(bmkp-default-bookmark-name))
current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'switch-to-buffer use-region-p))
(defun bmkp-jump-in-navlist-other-window (bookmark-name &optional use-region-p)
"Same as `bmkp-jump-in-navlist', but use another window."
(interactive
(progn (unless bmkp-nav-alist
(bookmark-maybe-load-default-file)
(setq bmkp-nav-alist bookmark-alist)
(unless bmkp-nav-alist (error "No bookmarks"))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist))
(message "Bookmark navigation list is now the global bookmark list") (sit-for 2))
(let ((bookmark-alist bmkp-nav-alist))
(list (bookmark-completing-read "Jump to bookmark (in another window)"
(bmkp-default-bookmark-name))
current-prefix-arg))))
(bmkp-jump-1 bookmark-name 'bmkp-select-buffer-other-window use-region-p))
(defun bmkp-cycle (increment &optional other-window startoverp)
"Cycle through bookmarks in the navlist 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.
You can set the navigation list using commands
`bmkp-choose-navlist-from-bookmark-list' and
`bmkp-choose-navlist-of-type'.
You can cycle among bookmarks in the current buffer using
`bmkp-cycle-this-buffer' and
`bmkp-cycle-this-buffer-other-window.'
In Lisp code:
Non-nil OTHER-WINDOW means jump to the bookmark in another window.
Non-nil STARTOVERP means reset `bmkp-current-nav-bookmark' to the
first bookmark in the navlist."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) nil startovr)))
(unless bmkp-nav-alist
(bookmark-maybe-load-default-file)
(setq bmkp-nav-alist bookmark-alist)
(unless bmkp-nav-alist (error "No bookmarks"))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist))
(message "Bookmark navigation list is now the global bookmark list") (sit-for 2))
(unless (and bmkp-current-nav-bookmark (not startoverp)
(bookmark-get-bookmark bmkp-current-nav-bookmark 'NOERROR))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist)))
(if (bmkp-cycle-1 increment other-window startoverp)
(unless (or (bmkp-sequence-bookmark-p bmkp-current-nav-bookmark)
(bmkp-function-bookmark-p bmkp-current-nav-bookmark))
(message "Position: %9d, Bookmark: `%s'"
(point) (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark)))
(message "Invalid bookmark: `%s'" (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark))))
(defun bmkp-cycle-other-window (increment &optional startoverp)
"Same as `bmkp-cycle' but uses another window."
(interactive "p")
(bmkp-cycle increment 'OTHER-WINDOW startoverp))
(defun bmkp-cycle-this-file/buffer (increment &optional other-window startoverp)
"Cycle through bookmarks for this file/buffer by INCREMENT (default: 1).
If visiting a file, this is `bmkp-cycle-this-file'.
Otherwise, this is `bmkp-cycle-this-buffer'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) nil startovr)))
(if (buffer-file-name)
(bmkp-cycle-this-file increment other-window startoverp)
(bmkp-cycle-this-buffer increment other-window startoverp)))
(defun bmkp-cycle-this-file/buffer-other-window (increment &optional startoverp)
"Same as `bmkp-cycle-this-file/buffer' but use other window."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-file/buffer increment 'OTHER-WINDOW startoverp))
(defun bmkp-cycle-this-file (increment &optional other-window startoverp)
"Cycle through bookmarks for this file 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.
You can cycle among bookmarks beyond the current file using
`bmkp-cycle' and `bmkp-cycle-other-window.'
You can set your preferred sort order for this-file bookmarks by
customizing option `bmkp-this-file/buffer-cycle-sort-comparer'.
To change the sort order without customizing, you can use \
`\\[bmkp-this-file-bmenu-list]' to
show the `*Bookmark List*' with only this file's bookmarks, sort
them there, and use `\\[bmkp-choose-navlist-from-bookmark-list]', choosing \
`CURRENT *Bookmark List*' as
the navigation list.
Then you can cycle the bookmarks using `bmkp-cycle'
\(`\\[bmkp-next-bookmark-repeat]' etc.), instead of `bmkp-cycle-this-file'.
In Lisp code:
Non-nil OTHER-WINDOW means jump to the bookmark in another window.
Non-nil STARTOVERP means reset `bmkp-current-nav-bookmark' to the
first bookmark in the navlist."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) nil startovr)))
(bookmark-maybe-load-default-file)
(let ((bmkp-sort-comparer bmkp-this-file/buffer-cycle-sort-comparer))
(setq bmkp-nav-alist (bmkp-sort-omit (bmkp-this-file-alist-only))))
(unless bmkp-nav-alist (error "No bookmarks for this file"))
(unless (and bmkp-current-nav-bookmark (not startoverp)
(bookmark-get-bookmark bmkp-current-nav-bookmark 'NOERROR)
(bmkp-this-file-p bmkp-current-nav-bookmark))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist)))
(if (bmkp-cycle-1 increment other-window startoverp)
(unless (or (bmkp-sequence-bookmark-p bmkp-current-nav-bookmark)
(bmkp-function-bookmark-p bmkp-current-nav-bookmark))
(message "Position: %9d, Bookmark: `%s'"
(point) (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark)))
(message "Invalid bookmark: `%s'" (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark))))
(defun bmkp-cycle-this-file-other-window (increment &optional startoverp)
"Same as `bmkp-cycle-this-file' but use other window."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-file increment 'OTHER-WINDOW startoverp))
(defun bmkp-cycle-this-buffer (increment &optional other-window startoverp)
"Cycle through bookmarks in this buffer 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.
You can cycle among bookmarks beyond the current buffer using
`bmkp-cycle' and `bmkp-cycle-other-window.'
You can set your preferred sort order for this-buffer bookmarks by
customizing option `bmkp-this-file/buffer-cycle-sort-comparer'.
To change the sort order without customizing, you can use \
`\\[bmkp-this-buffer-bmenu-list]' to
show the `*Bookmark List*' with only this buffer's bookmarks, sort
them there, and use `\\[bmkp-choose-navlist-from-bookmark-list]', choosing \
`CURRENT *Bookmark List*' as
the navigation list.
Then you can cycle the bookmarks using `bmkp-cycle'
\(`\\[bmkp-next-bookmark-repeat]' etc.), instead of `bmkp-cycle-this-buffer'.
In Lisp code:
Non-nil OTHER-WINDOW means jump to the bookmark in another window.
Non-nil STARTOVERP means reset `bmkp-current-nav-bookmark' to the
first bookmark in the navlist."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) nil startovr)))
(bookmark-maybe-load-default-file)
(let ((bmkp-sort-comparer bmkp-this-file/buffer-cycle-sort-comparer))
(setq bmkp-nav-alist (bmkp-sort-omit (bmkp-this-buffer-alist-only))))
(unless bmkp-nav-alist (error "No bookmarks in this buffer"))
(unless (and bmkp-current-nav-bookmark (not startoverp)
(bookmark-get-bookmark bmkp-current-nav-bookmark 'NOERROR)
(bmkp-this-buffer-p bmkp-current-nav-bookmark))
(setq bmkp-current-nav-bookmark (car bmkp-nav-alist)))
(if (bmkp-cycle-1 increment other-window startoverp)
(unless (or (bmkp-sequence-bookmark-p bmkp-current-nav-bookmark)
(bmkp-function-bookmark-p bmkp-current-nav-bookmark))
(message "Position: %9d, Bookmark: `%s'"
(point) (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark)))
(message "Invalid bookmark: `%s'" (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark))))
(defun bmkp-cycle-this-buffer-other-window (increment &optional startoverp)
"Same as `bmkp-cycle-this-buffer' but use other window."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-buffer increment 'OTHER-WINDOW startoverp))
(defun bmkp-cycle-1 (increment &optional other-window startoverp)
"Helper for `bmkp-cycle*' commands.
Do nothing if `bmkp-current-nav-bookmark' is an invalid bookmark.
Return `bmkp-current-nav-bookmark', or nil if invalid.
NOTE: If `pop-up-frames' is non-nil, then cycling inhibits automatic
showing of annotations (`bookmark-automatically-show-annotations').
This is to prevent change of frame focus, so cycling can continue
properly.
See `bmkp-cycle' for descriptions of the arguments."
(let ((bookmark-alist bmkp-nav-alist)
(bookmark (bookmark-get-bookmark bmkp-current-nav-bookmark 'NOERROR))
(bmkp-use-region (eq 'cycling-too bmkp-use-region)))
(unless bookmark-alist (error "No bookmarks for cycling"))
(when bookmark
(setq bmkp-current-nav-bookmark
(if startoverp
(car bookmark-alist)
(let ((index (bmkp-list-position bookmark bookmark-alist #'eq)))
(if index
(nth (mod (+ increment index) (length bookmark-alist)) bookmark-alist)
(message "bmkp-cycle-1: Bookmark `%s' is not in navlist"
(bmkp-bookmark-name-from-record bmkp-current-nav-bookmark))
(car bookmark-alist)))))
(let ((bookmark-automatically-show-annotations
(and bookmark-automatically-show-annotations (not pop-up-frames))))
(if other-window
(bookmark-jump-other-window (bmkp-bookmark-name-from-record bmkp-current-nav-bookmark))
(save-selected-window (bmkp-bookmark-name-from-record
(bookmark-jump bmkp-current-nav-bookmark))))))
(and bookmark bmkp-current-nav-bookmark)))
(defun bmkp-list-position (item items &optional test)
"Find the first occurrence of ITEM in list ITEMS.
Return the index of the matching item, or nil if not found.
Items are compared using binary predicate TEST, or `equal' if TEST is
nil."
(unless test (setq test 'equal))
(let ((pos 0))
(catch 'bmkp-list-position
(dolist (itm items)
(when (funcall test item itm) (throw 'bmkp-list-position pos))
(setq pos (1+ pos)))
nil)))
(defun bmkp-next-bookmark (n &optional startoverp)
"Jump to the Nth next bookmark in the bookmark navigation list.
N defaults to 1, meaning the next bookmark.
Plain `C-u' means start over at first bookmark.
See also `bmkp-cycle'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle n nil startoverp))
(defun bmkp-previous-bookmark (n &optional startoverp)
"Jump to the Nth previous bookmark in the bookmark navigation list.
See `bmkp-next-bookmark'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle (- n) nil startoverp))
(defun bmkp-next-bookmark-repeat (arg)
"Jump to the Nth-next bookmark in the bookmark navigation list.
This is a repeatable version of `bmkp-next-bookmark'.
N defaults to 1, meaning the next bookmark.
Plain `C-u' means start over at the first bookmark (and no repeat)."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-next-bookmark))
(defun bmkp-previous-bookmark-repeat (arg)
"Jump to the Nth-previous bookmark in the bookmark navigation list.
See `bmkp-next-bookmark-repeat'."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-previous-bookmark))
(defun bmkp-next-bookmark-this-file/buffer (n &optional startoverp)
"Jump to the Nth-next bookmark for the current file/buffer.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one.
See also `bmkp-cycle-this-file/buffer'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-file/buffer n nil startoverp))
(defun bmkp-previous-bookmark-this-file/buffer (n &optional startoverp)
"Jump to the Nth-previous bookmark for the current file/buffer.
See `bmkp-next-bookmark-this-file/buffer'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-file/buffer (- n) nil startoverp))
(defun bmkp-next-bookmark-this-file/buffer-repeat (arg)
"Jump to the Nth next bookmark for the current file/buffer.
This is a repeatable version of `bmkp-next-bookmark-this-file/buffer'.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one (and no repeat)."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-next-bookmark-this-file/buffer))
(defun bmkp-previous-bookmark-this-file/buffer-repeat (arg)
"Jump to the Nth previous bookmark for the current file/buffer.
See `bmkp-next-bookmark-this-file/buffer-repeat'."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-previous-bookmark-this-file/buffer))
(defun bmkp-next-bookmark-this-file (n &optional startoverp)
"Jump to the Nth-next bookmark for the current file.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one.
See also `bmkp-cycle-this-file'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-file n nil startoverp))
(defun bmkp-previous-bookmark-this-file (n &optional startoverp)
"Jump to the Nth-previous bookmark for the current file.
See `bmkp-next-bookmark-this-file'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-file (- n) nil startoverp))
(defun bmkp-next-bookmark-this-file-repeat (arg)
"Jump to the Nth next bookmark for the current file.
This is a repeatable version of `bmkp-next-bookmark-this-file'.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one (and no repeat)."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-next-bookmark-this-file))
(defun bmkp-previous-bookmark-this-file-repeat (arg)
"Jump to the Nth previous bookmark for the current file.
See `bmkp-next-bookmark-this-file-repeat'."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-previous-bookmark-this-file))
(defun bmkp-next-bookmark-this-buffer (n &optional startoverp)
"Jump to the Nth-next bookmark in the current buffer.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one.
See also `bmkp-cycle-this-buffer'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-buffer n nil startoverp))
(defun bmkp-previous-bookmark-this-buffer (n &optional startoverp)
"Jump to the Nth-previous bookmark in the current buffer.
See `bmkp-next-bookmark-this-buffer'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(bmkp-cycle-this-buffer (- n) nil startoverp))
(defun bmkp-next-bookmark-this-buffer-repeat (arg)
"Jump to the Nth next bookmark in the current buffer.
This is a repeatable version of `bmkp-next-bookmark-this-buffer'.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one (and no repeat)."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-next-bookmark-this-buffer))
(defun bmkp-previous-bookmark-this-buffer-repeat (arg)
"Jump to the Nth previous bookmark in the current buffer.
See `bmkp-next-bookmark-this-buffer-repeat'."
(interactive "P")
(require 'repeat)
(bmkp-repeat-command 'bmkp-previous-bookmark-this-buffer))
(defun bmkp-next-bookmark-w32 (n &optional startoverp)
"Windows `Open' the Nth next bookmark in the bookmark navigation list.
MS Windows only. Invokes the program associated with the file type.
N defaults to 1, meaning the next one.
Plain `C-u' means start over at the first one.
See also `bmkp-cycle'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(let ((bmkp-use-w32-browser-p t)) (bmkp-cycle n nil startoverp)))
(defun bmkp-previous-bookmark-w32 (n &optional startoverp)
"Windows `Open' the Nth previous bookmark in the bookmark navlist.
See `bmkp-next-bookmark-w32'."
(interactive (let ((startovr (consp current-prefix-arg)))
(list (if startovr 1 (prefix-numeric-value current-prefix-arg)) startovr)))
(let ((bmkp-use-w32-browser-p t)) (bmkp-cycle (- n) nil startoverp)))
(defun bmkp-next-bookmark-w32-repeat (arg)
"Windows `Open' the Nth next bookmark in the bookmark navigation list.
This is a repeatable version of `bmkp-next-bookmark'.
N defaults to 1, meaning the next bookmark.
Plain `C-u' means start over at the first one (and no repeat)."
(interactive "P")
(require 'repeat)
(let ((bmkp-use-w32-browser-p t)) (bmkp-repeat-command 'bmkp-next-bookmark)))
(defun bmkp-previous-bookmark-w32-repeat (arg)
"Windows `Open' the Nth previous bookmark in the bookmark navlist.
See `bmkp-next-bookmark-w32-repeat'."
(interactive "P")
(require 'repeat)
(let ((bmkp-use-w32-browser-p t)) (bmkp-repeat-command 'bmkp-previous-bookmark)))
(bmkp-define-cycle-command "autonamed")
(bmkp-define-cycle-command "autonamed" 'OTHER-WINDOW)
(bmkp-define-cycle-command "bookmark-list")
(bmkp-define-cycle-command "desktop")
(bmkp-define-cycle-command "dired")
(bmkp-define-cycle-command "dired" 'OTHER-WINDOW)
(bmkp-define-cycle-command "file")
(bmkp-define-cycle-command "file" 'OTHER-WINDOW)
(bmkp-define-cycle-command "gnus")
(bmkp-define-cycle-command "gnus" 'OTHER-WINDOW)
(bmkp-define-cycle-command "info")
(bmkp-define-cycle-command "info" 'OTHER-WINDOW)
(when (featurep 'bookmark+-lit)
(bmkp-define-cycle-command "lighted")
(bmkp-define-cycle-command "lighted" 'OTHER-WINDOW))
(bmkp-define-cycle-command "local-file")
(bmkp-define-cycle-command "local-file" 'OTHER-WINDOW)
(bmkp-define-cycle-command "man")
(bmkp-define-cycle-command "man" 'OTHER-WINDOW)
(bmkp-define-cycle-command "non-file")
(bmkp-define-cycle-command "non-file" 'OTHER-WINDOW)
(bmkp-define-cycle-command "remote-file")
(bmkp-define-cycle-command "remote-file" 'OTHER-WINDOW)
(bmkp-define-cycle-command "specific-buffers")
(bmkp-define-cycle-command "specific-buffers" 'OTHER-WINDOW)
(bmkp-define-cycle-command "specific-files")
(bmkp-define-cycle-command "specific-files" 'OTHER-WINDOW)
(bmkp-define-cycle-command "variable-list")
(bmkp-define-cycle-command "url")
(bmkp-define-cycle-command "url" 'OTHER-WINDOW)
(bmkp-define-next+prev-cycle-commands "autonamed")
(bmkp-define-next+prev-cycle-commands "bookmark-list")
(bmkp-define-next+prev-cycle-commands "desktop")
(bmkp-define-next+prev-cycle-commands "dired")
(bmkp-define-next+prev-cycle-commands "file")
(bmkp-define-next+prev-cycle-commands "gnus")
(bmkp-define-next+prev-cycle-commands "info")
(bmkp-define-next+prev-cycle-commands "lighted")
(bmkp-define-next+prev-cycle-commands "local-file")
(bmkp-define-next+prev-cycle-commands "man")
(bmkp-define-next+prev-cycle-commands "non-file")
(bmkp-define-next+prev-cycle-commands "remote-file")
(bmkp-define-next+prev-cycle-commands "specific-buffers")
(bmkp-define-next+prev-cycle-commands "specific-files")
(bmkp-define-next+prev-cycle-commands "variable-list")
(bmkp-define-next+prev-cycle-commands "url")
(defun bmkp-toggle-autonamed-bookmark-set/delete (&optional position allp)
"If there is an autonamed bookmark at point, delete it, else create one.
The bookmark created has no region. Its name is formatted according
to option `bmkp-autoname-bookmark-function'.
With a prefix arg, delete *ALL* autonamed bookmarks for this buffer.
Non-interactively, act at POSITION, not point. If nil, act at point."
(interactive "d\nP")
(unless position (setq position (point)))
(if allp
(bmkp-delete-all-autonamed-for-this-buffer)
(let ((bmk-name (funcall bmkp-autoname-bookmark-function position)))
(if (not (bmkp-get-bookmark-in-alist bmk-name 'NOERROR))
(let ((mark-active nil))
(bookmark-set bmk-name)
(message "Set bookmark `%s'" bmk-name))
(bookmark-delete bmk-name)
(message "Deleted bookmark `%s'" bmk-name)))))
(defun bmkp-set-autonamed-bookmark (&optional position msg-p)
"Set an autonamed bookmark at point.
The bookmark created has no region. Its name is formatted according
to option `bmkp-autoname-bookmark-function'.
Non-interactively:
- Act at POSITION, not point. If nil, act at point.
- Non-nil optional arg MSG-P means display a status message."
(interactive (list (point) 'MSG))
(unless position (setq position (point)))
(let ((bmk-name (funcall bmkp-autoname-bookmark-function position))
(mark-active nil))
(bookmark-set bmk-name)
(when msg-p (message "Set bookmark `%s'" bmk-name))))
(defun bmkp-set-autonamed-bookmark-at-line (&optional number)
"Set an autonamed bookmark at the beginning of the current line.
With a prefix arg, set it at the line whose number is the numeric
prefix value."
(interactive (list (and current-prefix-arg (prefix-numeric-value current-prefix-arg))))
(if (not number)
(bmkp-set-autonamed-bookmark (line-beginning-position))
(save-excursion
(goto-char (point-min))
(let ((inhibit-field-text-motion t))
(bmkp-set-autonamed-bookmark (line-beginning-position number))))))
(when (> emacs-major-version 21)
(defun bmkp-occur-create-autonamed-bookmarks (&optional msg-p)
"Create an autonamed bookmark for each `occur' hit.
You can use this only in `Occur' mode (commands such as `occur' and
`multi-occur').
Non-interactively, non-nil MSG-P means display a status message."
(interactive "p")
(unless (eq major-mode 'occur-mode) (error "You must be in `occur-mode'"))
(let ((count 0))
(save-excursion
(goto-char (point-min))
(while (condition-case nil (progn (occur-next) t) (error nil))
(let* ((pos (get-text-property (point) 'occur-target))
(buf (and pos (marker-buffer pos))))
(when buf
(with-current-buffer buf
(goto-char pos)
(bmkp-set-autonamed-bookmark (point)))
(setq count (1+ count))))))
(when msg-p (message "Created %d autonamed bookmarks" count)))))
(defun bmkp-set-autonamed-regexp-buffer (regexp &optional msg-p)
"Set autonamed bookmarks at matches for REGEXP in the buffer.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (list (read-string "Regexp: " nil 'regexp-history) 'MSG))
(bmkp-set-autonamed-regexp-region regexp (point-min) (point-max) msg-p))
(defun bmkp-set-autonamed-regexp-region (regexp beg end &optional msg-p)
"Set autonamed bookmarks at matches for REGEXP in the region.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (list (read-string "Regexp: " nil 'regexp-history)
(region-beginning) (region-end)
'MSG))
(let ((count 0))
(save-excursion
(goto-char beg)
(while (re-search-forward regexp end t)
(bmkp-set-autonamed-bookmark (point))
(setq count (1+ count))
(forward-line 1)))
(when msg-p (message "Set %d autonamed bookmarks" count))))
(defun bmkp-autoname-bookmark-function-default (position)
"Return a bookmark name using POSITION and the current buffer name.
The name is composed as follows:
POSITION followed by a space and then the buffer name.
The position value is prefixed with zeros to comprise 9 characters.
For example, for POSITION value 31416 and current buffer `my-buffer',
the name returned would be `000031416 my-buffer'"
(format "%09d %s" (abs position) (buffer-name)))
(defun bmkp-delete-all-autonamed-for-this-buffer (&optional msg-p)
"Delete all autonamed bookmarks for the current buffer.
Interactively, or with non-nil arg MSG-P, require confirmation.
To be deleted, a bookmark name must be an autonamed bookmark whose
buffer part names the current buffer."
(interactive "p")
(let ((bmks-to-delete (mapcar #'bmkp-bookmark-name-from-record
(bmkp-autonamed-this-buffer-alist-only))))
(if (null bmks-to-delete)
(when msg-p (message "No autonamed bookmarks for buffer `%s'" (buffer-name)))
(when (or (not msg-p)
(y-or-n-p (format "Delete ALL autonamed bookmarks for buffer `%s'? " (buffer-name))))
(let ((bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk bmks-to-delete) (bookmark-delete bmk 'BATCHP)))
(bmkp-refresh/rebuild-menu-list nil (not msg-p))
(when msg-p (message "Deleted all bookmarks for buffer `%s'" (buffer-name)))))))
(defun bmkp-delete-autonamed-this-buffer-no-confirm (&optional no-refresh-p)
"Delete all autonamed bookmarks for this buffer, without confirmation.
Non-nil optional arg NO-REFRESH-P means do not refresh/rebuild the
bookmark-list."
(when (and bookmarks-already-loaded bookmark-alist)
(let ((bmks-to-delete (mapcar #'bmkp-bookmark-name-from-record
(bmkp-autonamed-this-buffer-alist-only)))
(bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk bmks-to-delete) (bookmark-delete bmk 'BATCHP)))
(unless no-refresh-p
(bmkp-refresh/rebuild-menu-list nil 'BATCHP))))
(defun bmkp-delete-autonamed-no-confirm ()
"Delete all autonamed bookmarks for all buffers, without confirmation."
(when (and bookmarks-already-loaded bookmark-alist)
(let ((bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (buf (buffer-list))
(with-current-buffer buf
(bmkp-delete-autonamed-this-buffer-no-confirm 'NO-REFRESH-P))))
(bmkp-refresh/rebuild-menu-list nil 'BATCHP)))
(cond ((fboundp 'define-minor-mode)
(eval '(define-minor-mode bmkp-auto-idle-bookmark-mode
"Toggle automatic setting of a bookmark when Emacs is idle.
Non-interactively, turn automatic bookmarking on for the current
buffer if and only if ARG is positive.
To enable or disable automatic bookmarking in all buffers, use
`bmkp-global-auto-idle-bookmark-mode'.
When the mode is enabled in the current buffer, a bookmark is
automatically set every `bmkp-auto-idle-bookmark-mode-delay' seconds,
using the setting function that is the value of option
`bmkp-auto-idle-bookmark-mode-set-function'. Note that a buffer must
be current (selected) for an automatic bookmark to be created there -
it is not enough that the mode be enabled in the buffer.
Turning the mode on and off runs hooks
`bmkp-auto-idle-bookmark-mode-on-hook' and
`bmkp-auto-idle-bookmark-mode-off-hook', respectively.
If you want the automatic bookmarks to be temporary (not saved to your
bookmark file), then customize option
`bmkp-autotemp-bookmark-predicates' so that it includes the kind of
bookmarks that are set by `bmkp-auto-idle-bookmark-mode-set-function'.
For example, if automatic bookmarking sets autonamed bookmarks, then
`bmkp-autotemp-bookmark-predicates' should include
`bmkp-autonamed-bookmark-p' or
`bmkp-autonamed-this-buffer-bookmark-p'.
If you want the automatically created bookmarks to be highlighted,
then customize option `bmkp-auto-light-when-set' to highlight
bookmarks of the appropriate kind. For example, to highlight
autonamed bookmarks set it to `autonamed-bookmark'.
NOTE: If you use Emacs 21 then there is no global version of the mode
- that is, there is no command `bmkp-global-auto-idle-bookmark-mode'."
:init-value nil :group 'bookmark-plus :require 'bookmark+
:lighter bmkp-auto-idle-bookmark-mode-lighter
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
Bookmark bug: \
&body=Describe bug here, starting with `emacs -Q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Download" "http://www.emacswiki.org/bookmark+.el")
:link '(url-link :tag "Description" "http://www.emacswiki.org/BookmarkPlus")
:link '(emacs-commentary-link :tag "Commentary" "bookmark+")
(when bmkp-auto-idle-bookmark-mode-timer
(cancel-timer bmkp-auto-idle-bookmark-mode-timer)
(setq bmkp-auto-idle-bookmark-mode-timer nil))
(when bmkp-auto-idle-bookmark-mode
(setq bmkp-auto-idle-bookmark-mode-timer
(run-with-idle-timer bmkp-auto-idle-bookmark-mode-delay 'REPEAT
(lambda ()
(when (and bmkp-auto-idle-bookmark-mode
(bmkp-not-near-other-auto-idle-bmks))
(let ((bmkp-setting-auto-idle-bmk-p t))
(funcall bmkp-auto-idle-bookmark-mode-set-function)))))))
(when (interactive-p)
(message "Automatic bookmarking is now %s in buffer `%s'"
(if bmkp-auto-idle-bookmark-mode "ON" "OFF") (buffer-name)))))
(eval '(defun bmkp-turn-on-auto-idle-bookmark-mode ()
"Turn on `bmkp-auto-idle-bookmark-mode'."
(bmkp-auto-idle-bookmark-mode 1)))
(when (fboundp 'define-globalized-minor-mode)
(eval '(define-globalized-minor-mode bmkp-global-auto-idle-bookmark-mode
bmkp-auto-idle-bookmark-mode
bmkp-turn-on-auto-idle-bookmark-mode
:group 'bookmark-plus :require 'bookmark+))))
(t
(defun bmkp-auto-idle-bookmark-mode (&optional arg)
"Toggle automatic setting of a bookmark when Emacs is idle.
Non-interactively, turn automatic bookmarking on if and only if ARG is
positive.
When the mode is enabled, a bookmark is automatically set every
`bmkp-auto-idle-bookmark-mode-delay' seconds, using the setting
function that is the value of option
`bmkp-auto-idle-bookmark-mode-set-function'. Note that a buffer must
be current (selected) for an automatic bookmark to be created there -
it is not enough that the mode be enabled in the buffer.
If you want these bookmarks to be temporary (not saved to your
bookmark file), then customize option
`bmkp-autotemp-bookmark-predicates' so that it includes the kind of
bookmarks that are set by `bmkp-auto-idle-bookmark-mode-set-function'.
For example, if automatic bookmarking sets autonamed bookmarks, then
`bmkp-autotemp-bookmark-predicates' should include
`bmkp-autonamed-bookmark-p'.
If you want the automatically created bookmarks to be highlighted,
then customize option `bmkp-auto-light-when-set' to highlight
bookmarks of the appropriate kind. For example, to highlight
autonamed bookmarks set it to `autonamed-bookmark'.
NOTE: This is the Emacs 20 version of `bmkp-auto-idle-bookmark-mode',
which is global only, that is, all buffers are affected. If you
instead want it to be local only, then do both of the following in
your init file:
(make-variable-buffer-local 'bmkp-auto-idle-bookmark-mode)
(make-variable-buffer-local 'bmkp-auto-idle-bookmark-mode-timer)"
(interactive (list (or current-prefix-arg 'toggle)))
(setq bmkp-auto-idle-bookmark-mode (if (eq arg 'toggle)
(not bmkp-auto-idle-bookmark-mode)
(> (prefix-numeric-value arg) 0)))
(when bmkp-auto-idle-bookmark-mode-timer
(cancel-timer bmkp-auto-idle-bookmark-mode-timer)
(setq bmkp-auto-idle-bookmark-mode-timer nil))
(when bmkp-auto-idle-bookmark-mode
(setq bmkp-auto-idle-bookmark-mode-timer
(run-with-idle-timer bmkp-auto-idle-bookmark-mode-delay 'REPEAT
(lambda ()
(when (and bmkp-auto-idle-bookmark-mode
(bmkp-not-near-other-auto-idle-bmks))
(let ((bmkp-setting-auto-idle-bmk-p t))
(funcall bmkp-auto-idle-bookmark-mode-set-function)))))))
(when (interactive-p)
(message "Automatic bookmarking is now %s%s"
(if bmkp-auto-idle-bookmark-mode "ON" "OFF")
(if (local-variable-if-set-p 'bmkp-auto-idle-bookmark-mode)
(format " in buffer `%s'" (current-buffer))
""))))
(add-to-list 'minor-mode-alist `(bmkp-auto-idle-bookmark-mode
,bmkp-auto-idle-bookmark-mode-lighter))))
(defun bmkp-not-near-other-auto-idle-bmks (&optional position)
"Is POSITION far enough from automatic bookmarks to create a new one?
Return non-nil if `bmkp-auto-idle-bookmark-min-distance' is nil or if
POSITION is at least `bmkp-auto-idle-bookmark-min-distance' chars from
all other automatic bookmarks in the same buffer. Else return nil."
(unless position (setq position (point)))
(or (not bmkp-auto-idle-bookmark-min-distance)
(catch 'bmkp-not-near-other-auto-idle-bmks
(let (pos)
(dolist (bmk bmkp-auto-idle-bookmarks)
(when (and (bmkp-this-buffer-p bmk)
(setq pos (bookmark-get-position bmk))
(< (abs (- (point) pos)) bmkp-auto-idle-bookmark-min-distance))
(throw 'bmkp-not-near-other-auto-idle-bmks nil)))
t))))
(if (fboundp 'define-minor-mode)
(eval '(define-minor-mode bmkp-temporary-bookmarking-mode
"Toggle temporary bookmarking.
Temporary bookmarking means that any bookmark changes (creation,
modification, deletion) are NOT automatically saved.
Interactively, you are required to confirm turning on the mode.
When the mode is turned ON:
a. `bookmark-save-flag' is set to nil.
b. `bmkp-current-bookmark-file' is set to a new, empty bookmark file
in directory `temporary-file-directory' (via `make-temp-file').
c. That file is not saved automatically.
d. In the `*Bookmark List*' display, the major-mode mode-line
indicator is set to `TEMPORARY ONLY'.
Non-interactively, turn temporary bookmarking on if and only if ARG is
positive. Non-interactively there is no prompt for confirmation."
:init-value nil :global t :group 'bookmark-plus :lighter bmkp-temporary-bookmarking-mode-lighter
:link `(url-link :tag "Send Bug Report"
,(concat "mailto:" "drew.adams" "@" "oracle" ".com?subject=\
Bookmark bug: \
&body=Describe bug here, starting with `emacs -Q'. \
Don't forget to mention your Emacs and library versions."))
:link '(url-link :tag "Download" "http://www.emacswiki.org/bookmark+.el")
:link '(url-link :tag "Description" "http://www.emacswiki.org/BookmarkPlus")
:link '(emacs-commentary-link :tag "Commentary" "bookmark+")
(cond ((not bmkp-temporary-bookmarking-mode)
(when (fboundp 'bmkp-unlight-bookmarks)
(bmkp-unlight-bookmarks
'(bmkp-autonamed-overlays bmkp-non-autonamed-overlays) nil))
(bmkp-switch-to-last-bookmark-file)
(setq bmkp-last-bookmark-file bmkp-current-bookmark-file)
(when (interactive-p)
(message "Bookmarking is NOT temporary now. Restored previous bookmarks list")))
((or (not (interactive-p))
(y-or-n-p (format "%switch to only temporary bookmarking? "
(if bookmark-save-flag "Save current bookmarks, then s" "S"))))
(when (and (> bookmark-alist-modification-count 0) bookmark-save-flag)
(bookmark-save))
(let ((new-file (make-temp-file "bmkp-temp-")))
(bmkp-empty-file new-file)
(bookmark-load new-file t 'nosave)
(when bookmark-save-flag (bmkp-toggle-saving-bookmark-file (interactive-p))))
(when (interactive-p) (message "Bookmarking is now TEMPORARY")))
(t
(message "OK, canceled - bookmarking is NOT temporary")
(setq bmkp-temporary-bookmarking-mode nil)))))
(defun bmkp-temporary-bookmarking-mode (&optional arg)
"Toggle temporary bookmarking.
Temporary bookmarking means that any bookmark changes (creation,
modification, deletion) are NOT automatically saved.
Interactively, you are required to confirm turning on the mode.
When the mode is turned ON:
a. `bookmark-save-flag' is set to nil.
b. `bmkp-current-bookmark-file' is set to a new, empty bookmark file
in directory `temporary-file-directory' (via `make-temp-file').
c. That file is not saved automatically.
d. In the `*Bookmark List*' display, the major-mode mode-line
indicator is set to `TEMPORARY ONLY'.
Non-interactively, turn temporary bookmarking on if and only if ARG is
positive. Non-interactively there is no prompt for confirmation."
(interactive "P")
(setq bmkp-temporary-bookmarking-mode
(if arg (> (prefix-numeric-value arg) 0) (not bmkp-temporary-bookmarking-mode)))
(cond ((not bmkp-temporary-bookmarking-mode)
(when (fboundp 'bmkp-unlight-bookmarks)
(bmkp-unlight-bookmarks
'(bmkp-autonamed-overlays bmkp-non-autonamed-overlays) nil))
(bmkp-switch-to-last-bookmark-file)
(setq bmkp-last-bookmark-file bmkp-current-bookmark-file)
(run-hooks 'bmkp-temporary-bookmarking-mode-hook)
(when (interactive-p)
(message "Bookmarking is NOT temporary now. Restored previous bookmarks list")))
((or (not (interactive-p))
(y-or-n-p (format "%switch to only TEMPORARY bookmarking? "
(if bookmark-save-flag "Save current bookmarks, then s" "S"))))
(when (and (> bookmark-alist-modification-count 0) bookmark-save-flag)
(bookmark-save))
(let ((new-file (make-temp-file "bmkp-temp-")))
(bmkp-empty-file new-file)
(bookmark-load new-file t 'nosave)
(when bookmark-save-flag (bmkp-toggle-saving-bookmark-file (interactive-p))))
(run-hooks 'bmkp-temporary-bookmarking-mode-hook)
(when (interactive-p) (message "Bookmarking is now TEMPORARY")))
(t
(message "OK, canceled - bookmarking is NOT temporary")
(setq bmkp-temporary-bookmarking-mode nil))))
(add-to-list 'minor-mode-alist `(bmkp-temporary-bookmarking-mode
,bmkp-temporary-bookmarking-mode-lighter)))
(defun bmkp-toggle-autotemp-on-set (&optional msg-p)
"Toggle automatically making any bookmark temporary whenever it is set.
Non-interactively, non-nil MSG-P means display a status message."
(interactive "p")
(setq bmkp-autotemp-all-when-set-p (not bmkp-autotemp-all-when-set-p))
(when msg-p (message "Automatically making bookmarks temporary when set is now %s"
(if bmkp-autotemp-all-when-set-p "ON" "OFF"))))
(defun bmkp-toggle-temporary-bookmark (bookmark &optional msg-p)
"Toggle whether BOOKMARK is temporary (not saved to disk).
Return the full updated bookmark.
BOOKMARK is a bookmark name or a bookmark record.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) 'MSG))
(let ((was-temp (bmkp-temporary-bookmark-p bookmark)))
(bookmark-prop-set bookmark 'bmkp-temp (not was-temp))
(when msg-p (message "Bookmark `%s' is now %s"
(if (stringp bookmark) bookmark (bmkp-bookmark-name-from-record bookmark))
(if was-temp "SAVABLE" "TEMPORARY"))))
bookmark)
(defun bmkp-make-bookmark-temporary (bookmark &optional msg-p)
"Make BOOKMARK temporary (not saved to disk).
Return the full updated bookmark.
BOOKMARK is a bookmark name or a bookmark record.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) 'MSG))
(bookmark-prop-set bookmark 'bmkp-temp t)
(when msg-p (message "Bookmark `%s' is now TEMPORARY"
(if (stringp bookmark) bookmark (bmkp-bookmark-name-from-record bookmark))))
bookmark)
(defun bmkp-make-bookmark-savable (bookmark &optional msg-p)
"Make BOOKMARK savable to disk (not temporary).
Return the full updated bookmark.
BOOKMARK is a bookmark name or a bookmark record.
Non-interactively, non-nil MSG-P means display a status message."
(interactive (list (bookmark-completing-read "Bookmark" (bmkp-default-bookmark-name)) 'MSG))
(bookmark-prop-set bookmark 'bmkp-temp nil)
(when msg-p (message "Bookmark `%s' is now SAVABLE"
(if (stringp bookmark) bookmark (bmkp-bookmark-name-from-record bookmark))))
bookmark)
(defun bmkp-delete-all-temporary-bookmarks (&optional msg-p)
"Delete all temporary bookmarks, after confirmation.
These are bookmarks that are `bmkp-temporary-bookmark-p'. You can
make a bookmark temporary using `bmkp-make-bookmark-temporary' or
`bmkp-toggle-temporary-bookmark'.
Non-interactively, non-nil MSG-P means display a status message."
(interactive "p")
(let ((bmks-to-delete (mapcar #'bmkp-bookmark-name-from-record (bmkp-temporary-alist-only))))
(if (null bmks-to-delete)
(when msg-p (message "No temporary bookmarks to delete"))
(when (and msg-p (not (y-or-n-p (format "Delete ALL temporary bookmarks? "))))
(error "OK - delete canceled"))
(let ((bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk bmks-to-delete) (bookmark-delete bmk 'BATCHP)))
(bmkp-refresh/rebuild-menu-list nil (not msg-p))
(when msg-p (message "Deleted all temporary bookmarks")))))
(defun bmkp-delete-temporary-no-confirm ()
"Delete all temporary bookmarks, without confirmation."
(when (and bookmarks-already-loaded bookmark-alist)
(let ((bmks-to-delete (mapcar #'bmkp-bookmark-name-from-record (bmkp-temporary-alist-only)))
(bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag)))
(dolist (bmk bmks-to-delete) (bookmark-delete bmk 'BATCHP)))
(bmkp-refresh/rebuild-menu-list nil 'BATCHP)))
(defun bmkp-delete-bookmarks (&optional position allp alist msg-p)
"Delete some bookmarks at point or all bookmarks in the buffer.
With no prefix argument, delete some bookmarks at point.
If there is more than one, require confirmation for each.
With a prefix argument, delete *ALL* bookmarks in the current buffer.
Non-interactively:
* Delete at POSITION, not point. If nil, delete at point.
* Non-nil optional arg ALLP means delete all bookmarks in the buffer.
* ALIST is the alist of bookmarks.
If nil, use the bookmarks in the current buffer.
* Non-nil MSG-P means display informative messages."
(interactive "d\nP\ni\np")
(unless position (setq position (point)))
(let ((bmks-to-delete (and allp (mapcar #'bmkp-bookmark-name-from-record
(bmkp-this-buffer-alist-only))))
(bmks-deleted ())
(bookmark-save-flag (and (not bmkp-count-multi-mods-as-one-flag)
bookmark-save-flag))
bmk-pos)
(when (and msg-p bmks-to-delete (not (y-or-n-p (format "Delete ALL bookmarks in buffer `%s'? "
(buffer-name)))))
(error "Canceled - no bookmarks deleted"))
(cond (bmks-to-delete
(dolist (bname bmks-to-delete) (bookmark-delete bname 'BATCHP))
(bmkp-refresh/rebuild-menu-list nil (not msg-p))
(when msg-p (message "Deleted all bookmarks in buffer `%s'" (buffer-name))))
(allp
(when msg-p (message "No bookmarks to delete in buffer `%s'" (buffer-name))))
(t
(let (bname)
(dolist (bmk (or alist (bmkp-this-buffer-alist-only)))
(when (eq position (setq bmk-pos (bookmark-get-position bmk)))
(setq bname (bmkp-bookmark-name-from-record bmk))
(unless (memq bname bmks-to-delete)
(setq bmks-to-delete (cons bname bmks-to-delete))))))
(cond ((cadr bmks-to-delete)
(dolist (bname bmks-to-delete)
(when (or (not msg-p) (y-or-n-p (format "Delete bookmark `%s'? " bname)))
(bookmark-delete bname 'BATCHP)
(unless (memq bname bmks-deleted) (setq bmks-deleted (cons bname bmks-deleted)))))
(bmkp-refresh/rebuild-menu-list nil (not msg-p))
(when msg-p
(message (if bmks-deleted
(format "Deleted bookmarks: %s"
(mapconcat (lambda (bname) (format "`%s'" bname)) bmks-deleted
", "))
"No bookmarks deleted"))))
(bmks-to-delete
(bookmark-delete (car bmks-to-delete))
(when msg-p (message "Deleted bookmark `%s'" (car bmks-to-delete))))
(t
(when msg-p (message "No bookmarks at point to delete"))))))))
(defun bmkp-thing-at-point (thing &optional syntax-table)
"`thingatpt+.el' version of `thing-at-point', if possible.
`tap-thing-at-point' if defined, else `thing-at-point'.
if non-nil, set SYNTAX-TABLE for the duration."
(if (fboundp 'tap-thing-at-point)
(tap-thing-at-point thing syntax-table)
(if (and (syntax-table-p syntax-table) (fboundp 'with-syntax-table))
(with-syntax-table syntax-table (thing-at-point thing))
(thing-at-point thing))))
(provide 'bookmark+-1)