Fix attribution in a ChangeLog entry.
[bpt/emacs.git] / lisp / bookmark.el
CommitLineData
e8af40ee 1;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
b3bf02fa 2
0d30b337 3;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
114f9c96 4;; 2004, 2005, 2006, 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
b3bf02fa 5
60d0378e
KF
6;; Author: Karl Fogel <kfogel@red-bean.com>
7;; Maintainer: Karl Fogel <kfogel@red-bean.com>
b3bf02fa 8;; Created: July, 1993
e3437989 9;; Keywords: bookmarks, placeholders, annotations
b3bf02fa
RS
10
11;; This file is part of GNU Emacs.
12
eb3fa2cf 13;; GNU Emacs is free software: you can redistribute it and/or modify
b3bf02fa 14;; it under the terms of the GNU General Public License as published by
eb3fa2cf
GM
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
b3bf02fa
RS
17
18;; GNU Emacs is distributed in the hope that it will be useful,
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
22
23;; You should have received a copy of the GNU General Public License
eb3fa2cf 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
b578f267
EN
25
26;;; Commentary:
27
28;; This package is for setting "bookmarks" in files. A bookmark
29;; associates a string with a location in a certain file. Thus, you
30;; can navigate your way to that location by providing the string.
31;; See the "User Variables" section for customizations.
b3bf02fa 32
e3437989 33\f
e8af40ee 34;;; Code:
b3bf02fa 35
b578f267 36(require 'pp)
2ef435bf 37(eval-when-compile (require 'cl))
b578f267 38
e3437989 39;;; Misc comments:
b3bf02fa 40;;
e3437989 41;; If variable bookmark-use-annotations is non-nil, an annotation is
dbe99ae9 42;; queried for when setting a bookmark.
11eb4275 43;;
d22d6453
RS
44;; The bookmark list is sorted lexically by default, but you can turn
45;; this off by setting bookmark-sort-flag to nil. If it is nil, then
46;; the list will be presented in the order it is recorded
47;; (chronologically), which is actually fairly useful as well.
b3bf02fa 48
4eadcdf8
RS
49;;; User Variables
50
bbf5eb28 51(defgroup bookmark nil
9848f0ca 52 "Setting, annotation and jumping to bookmarks."
bbf5eb28
RS
53 :group 'matching)
54
55
56(defcustom bookmark-use-annotations nil
fc22668d 57 "If non-nil, saving a bookmark queries for an annotation in a buffer."
bbf5eb28
RS
58 :type 'boolean
59 :group 'bookmark)
4eadcdf8
RS
60
61
bbf5eb28 62(defcustom bookmark-save-flag t
fc22668d 63 "Controls when Emacs saves bookmarks to a file.
9848f0ca 64--> nil means never save bookmarks, except when `bookmark-save' is
0472835f 65 explicitly called (\\[bookmark-save]).
4eadcdf8 66--> t means save bookmarks when Emacs is killed.
3b526bae 67--> Otherwise, it should be a number that is the frequency with which
0472835f 68 the bookmark list is saved (i.e.: the number of times which
4eadcdf8 69 Emacs' bookmark list may be modified before it is automatically
0472835f 70 saved.). If it is a number, Emacs will also automatically save
4eadcdf8
RS
71 bookmarks when it is killed.
72
73Therefore, the way to get it to save every time you make or delete a
0472835f
JB
74bookmark is to set this variable to 1 (or 0, which produces the same
75behavior.)
4eadcdf8
RS
76
77To specify the file in which to save them, modify the variable
9848f0ca 78`bookmark-default-file', which is `~/.emacs.bmk' by default."
31fa1bd1 79 :type '(choice (const nil) integer (other t))
bbf5eb28 80 :group 'bookmark)
4eadcdf8
RS
81
82
83(defconst bookmark-old-default-file "~/.emacs-bkmrks"
9201cc28 84 "The `.emacs.bmk' file used to be called this name.")
4eadcdf8
RS
85
86
87;; defvarred to avoid a compilation warning:
88(defvar bookmark-file nil
89 "Old name for `bookmark-default-file'.")
90
bbf5eb28 91(defcustom bookmark-default-file
4eadcdf8
RS
92 (if bookmark-file
93 ;; In case user set `bookmark-file' in her .emacs:
94 bookmark-file
398a825b 95 (locate-user-emacs-file "bookmarks" ".emacs.bmk"))
fc22668d 96 "File in which to save bookmarks by default."
bbf5eb28
RS
97 :type 'file
98 :group 'bookmark)
4eadcdf8
RS
99
100
bbf5eb28 101(defcustom bookmark-version-control 'nospecial
fc22668d 102 "Whether or not to make numbered backups of the bookmark file.
4eadcdf8
RS
103It can have four values: t, nil, `never', and `nospecial'.
104The first three have the same meaning that they do for the
105variable `version-control', and the final value `nospecial' means just
bbf5eb28 106use the value of `version-control'."
31fa1bd1
AS
107 :type '(choice (const nil) (const never) (const nospecial)
108 (other t))
bbf5eb28 109 :group 'bookmark)
4eadcdf8
RS
110
111
bbf5eb28 112(defcustom bookmark-completion-ignore-case t
fc22668d 113 "Non-nil means bookmark functions ignore case in completion."
bbf5eb28
RS
114 :type 'boolean
115 :group 'bookmark)
4eadcdf8
RS
116
117
bbf5eb28 118(defcustom bookmark-sort-flag t
fc22668d 119 "Non-nil means that bookmarks will be displayed sorted by bookmark name.
9848f0ca 120Otherwise they will be displayed in LIFO order (that is, most
bbf5eb28
RS
121recently set ones come first, oldest ones come last)."
122 :type 'boolean
123 :group 'bookmark)
4eadcdf8
RS
124
125
bbf5eb28 126(defcustom bookmark-automatically-show-annotations t
fc22668d 127 "Non-nil means show annotations when jumping to a bookmark."
bbf5eb28
RS
128 :type 'boolean
129 :group 'bookmark)
4eadcdf8
RS
130
131
aef053eb
KF
132(defconst bookmark-bmenu-header-height 2
133 "Number of lines used for the *Bookmark List* header.")
134
54136282
KF
135(defconst bookmark-bmenu-marks-width 2
136 "Number of columns (chars) used for the *Bookmark List* marks column,
137including the annotations column.")
aef053eb 138
bbf5eb28 139(defcustom bookmark-bmenu-file-column 30
fc22668d 140 "Column at which to display filenames in a buffer listing bookmarks.
bbf5eb28
RS
141You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
142 :type 'integer
143 :group 'bookmark)
4eadcdf8
RS
144
145
bbf5eb28 146(defcustom bookmark-bmenu-toggle-filenames t
fc22668d 147 "Non-nil means show filenames when listing bookmarks.
4eadcdf8 148This may result in truncated bookmark names. To disable this, put the
9848f0ca 149following in your `.emacs' file:
4eadcdf8 150
0472835f 151\(setq bookmark-bmenu-toggle-filenames nil)"
bbf5eb28
RS
152 :type 'boolean
153 :group 'bookmark)
4eadcdf8
RS
154
155
bbf5eb28 156(defcustom bookmark-menu-length 70
fc22668d 157 "Maximum length of a bookmark name displayed on a popup menu."
bbf5eb28 158 :type 'integer
85d457c6 159 :group 'bookmark)
4eadcdf8 160
26d9285f 161;; FIXME: Is it really worth a customization option?
1e7d4475 162(defcustom bookmark-search-delay 0.2
26d9285f 163 "Time before `bookmark-bmenu-search' updates the display."
1e7d4475
SM
164 :group 'bookmark
165 :type 'integer)
166
37789292
RF
167(defface bookmark-menu-heading
168 '((t (:inherit font-lock-type-face)))
169 "Face used to highlight the heading in bookmark menu buffers."
170 :group 'bookmark
171 :version "22.1")
172
173
4eadcdf8 174;;; No user-serviceable parts beyond this point.
b3bf02fa
RS
175
176;; Added for lucid emacs compatibility, db
177(or (fboundp 'defalias) (fset 'defalias 'fset))
178
d22d6453 179;; suggested for lucid compatibility by david hughes:
4eadcdf8 180(or (fboundp 'frame-height) (defalias 'frame-height 'screen-height))
d22d6453 181
e3437989
RS
182\f
183;;; Keymap stuff:
b3bf02fa 184
77bc05c7
RS
185;; Set up these bindings dumping time *only*;
186;; if the user alters them, don't override the user when loading bookmark.el.
187
e1321788
JL
188;;;###autoload (define-key ctl-x-r-map "b" 'bookmark-jump)
189;;;###autoload (define-key ctl-x-r-map "m" 'bookmark-set)
190;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
36ae4ff7 191
d22d6453 192;;;###autoload
79363d93
SM
193(defvar bookmark-map
194 (let ((map (make-sparse-keymap)))
195 ;; Read the help on all of these functions for details...
196 (define-key map "x" 'bookmark-set)
197 (define-key map "m" 'bookmark-set) ;"m"ark
198 (define-key map "j" 'bookmark-jump)
199 (define-key map "g" 'bookmark-jump) ;"g"o
200 (define-key map "o" 'bookmark-jump-other-window)
201 (define-key map "i" 'bookmark-insert)
202 (define-key map "e" 'edit-bookmarks)
203 (define-key map "f" 'bookmark-insert-location) ;"f"ind
204 (define-key map "r" 'bookmark-rename)
205 (define-key map "d" 'bookmark-delete)
206 (define-key map "l" 'bookmark-load)
207 (define-key map "w" 'bookmark-write)
208 (define-key map "s" 'bookmark-save)
209 map)
9aef3b21
RS
210 "Keymap containing bindings to bookmark functions.
211It is not bound to any key by default: to bind it
212so that you have a bookmark prefix, just use `global-set-key' and bind a
213key of your choice to `bookmark-map'. All interactive bookmark
b3bf02fa
RS
214functions have a binding in this keymap.")
215
79363d93 216;;;###autoload (fset 'bookmark-map bookmark-map)
e3437989 217
e3437989
RS
218\f
219;;; Core variables and data structures:
7e2d009d 220(defvar bookmark-alist ()
e3437989 221 "Association list of bookmarks and their records.
7c85c02b
KF
222Bookmark functions update the value automatically.
223You probably do NOT want to change the value yourself.
4eadcdf8 224
7c85c02b 225The value is an alist with entries of the form
4eadcdf8 226
7c85c02b 227 (BOOKMARK-NAME . PARAM-ALIST)
4eadcdf8 228
7c85c02b 229or the deprecated form (BOOKMARK-NAME PARAM-ALIST).
4eadcdf8 230
7c85c02b 231 BOOKMARK-NAME is the name you gave to the bookmark when creating it.
4eadcdf8 232
7c85c02b
KF
233 PARAM-ALIST is an alist of bookmark information. The order of the
234 entries in PARAM-ALIST is not important. The possible entries are
235 described below. An entry with a key but null value means the entry
236 is not used.
43f8b275 237
7c85c02b 238 (filename . FILENAME)
43f8b275 239 (position . POS)
7c85c02b
KF
240 (front-context-string . STR-AFTER-POS)
241 (rear-context-string . STR-BEFORE-POS)
242 (handler . HANDLER)
243 (annotation . ANNOTATION)
244
245 FILENAME names the bookmarked file.
246 POS is the bookmarked buffer position (position in the file).
247 STR-AFTER-POS is buffer text that immediately follows POS.
248 STR-BEFORE-POS is buffer text that immediately precedes POS.
249 ANNOTATION is a string that describes the bookmark.
250 See options `bookmark-use-annotations' and
251 `bookmark-automatically-show-annotations'.
252 HANDLER is a function that provides the bookmark-jump behavior for a
253 specific kind of bookmark. This is the case for Info bookmarks,
254 for instance. HANDLER must accept a bookmark as argument.")
e3437989 255
67b70de9 256(defvar bookmarks-already-loaded nil
0472835f 257 "Non-nil if and only if bookmarks have been loaded from `bookmark-default-file'.")
d22d6453 258
e3437989 259
b3bf02fa 260;; more stuff added by db.
d22d6453 261
dbe99ae9 262(defvar bookmark-current-bookmark nil
9aef3b21
RS
263 "Name of bookmark most recently used in the current file.
264It is buffer local, used to make moving a bookmark forward
8027e2ad 265through a file easier.")
b3bf02fa
RS
266
267(make-variable-buffer-local 'bookmark-current-bookmark)
268
e3437989 269
b3bf02fa 270(defvar bookmark-alist-modification-count 0
9aef3b21 271 "Number of modifications to bookmark list since it was last saved.")
b3bf02fa 272
e3437989 273
e3437989 274(defvar bookmark-search-size 16
9aef3b21 275 "Length of the context strings recorded on either side of a bookmark.")
b3bf02fa 276
e3437989 277
67b70de9
KF
278(defvar bookmark-current-buffer nil
279 "The buffer in which a bookmark is currently being set or renamed.
280Functions that insert strings into the minibuffer use this to know
281the source buffer for that information; see `bookmark-yank-word' and
282`bookmark-insert-current-bookmark' for example.")
283
284
285(defvar bookmark-yank-point 0
286 "The next point from which to pull source text for `bookmark-yank-word'.
0472835f 287This point is in `bookmark-current-buffer'.")
67b70de9 288
b3bf02fa 289
1e7d4475
SM
290(defvar bookmark-quit-flag nil
291 "Non nil make `bookmark-bmenu-search' quit immediately.")
e3437989 292\f
b894c439
KF
293;; Helper functions and macros.
294
295(defmacro with-buffer-modified-unmodified (&rest body)
296 "Run BODY while preserving the buffer's `buffer-modified-p' state."
297 (let ((was-modified (make-symbol "was-modified")))
298 `(let ((,was-modified (buffer-modified-p)))
299 (unwind-protect
300 (progn ,@body)
301 (set-buffer-modified-p ,was-modified)))))
302
303;; Only functions below, in this page and the next one (file formats),
304;; need to know anything about the format of bookmark-alist entries.
e3437989
RS
305;; Everyone else should go through them.
306
307(defun bookmark-name-from-full-record (full-record)
0472835f 308 "Return name of FULL-RECORD (an alist element instead of a string)."
e3437989
RS
309 (car full-record))
310
311
312(defun bookmark-all-names ()
313 "Return a list of all current bookmark names."
314 (bookmark-maybe-load-default-file)
43f8b275 315 (mapcar 'bookmark-name-from-full-record bookmark-alist))
e3437989
RS
316
317
2ef435bf 318(defun bookmark-get-bookmark (bookmark &optional noerror)
43f8b275 319 "Return the bookmark record corresponding to BOOKMARK.
13901bcb
KF
320If BOOKMARK is a string, look for the corresponding bookmark record in
321`bookmark-alist'; return it if found, otherwise error. Else if
322BOOKMARK is already a bookmark record, just return it."
43f8b275
SM
323 (cond
324 ((consp bookmark) bookmark)
325 ((stringp bookmark)
2ef435bf
SM
326 (or (assoc-string bookmark bookmark-alist bookmark-completion-ignore-case)
327 (unless noerror (error "Invalid bookmark %s" bookmark))))))
e3437989
RS
328
329
330(defun bookmark-get-bookmark-record (bookmark)
13901bcb
KF
331 "Return the record portion of the entry for BOOKMARK in
332`bookmark-alist' (that is, all information but the name).
333BOOKMARK may be a bookmark name (a string) or a bookmark record."
2ef435bf 334 (let ((alist (cdr (bookmark-get-bookmark bookmark))))
43f8b275
SM
335 ;; The bookmark objects can either look like (NAME ALIST) or
336 ;; (NAME . ALIST), so we have to distinguish the two here.
337 (if (and (null (cdr alist)) (consp (caar alist)))
338 (car alist) alist)))
e3437989
RS
339
340
341(defun bookmark-set-name (bookmark newname)
13901bcb
KF
342 "Set BOOKMARK's name to NEWNAME.
343BOOKMARK may be a bookmark name (a string) or a bookmark record."
91169ba7
RS
344 (setcar
345 (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
346 newname))
e3437989 347
02a5ba27 348(defun bookmark-prop-get (bookmark prop)
13901bcb
KF
349 "Return the property PROP of BOOKMARK, or nil if none.
350BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27
SM
351 (cdr (assq prop (bookmark-get-bookmark-record bookmark))))
352
353(defun bookmark-prop-set (bookmark prop val)
13901bcb
KF
354 "Set the property PROP of BOOKMARK to VAL.
355BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27
SM
356 (let ((cell (assq prop (bookmark-get-bookmark-record bookmark))))
357 (if cell
358 (setcdr cell val)
359 (nconc (bookmark-get-bookmark-record bookmark)
360 (list (cons prop val))))))
e3437989
RS
361
362(defun bookmark-get-annotation (bookmark)
13901bcb
KF
363 "Return the annotation of BOOKMARK, or nil if none.
364BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 365 (bookmark-prop-get bookmark 'annotation))
e3437989
RS
366
367(defun bookmark-set-annotation (bookmark ann)
13901bcb
KF
368 "Set the annotation of BOOKMARK to ANN.
369BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 370 (bookmark-prop-set bookmark 'annotation ann))
e3437989
RS
371
372
373(defun bookmark-get-filename (bookmark)
13901bcb
KF
374 "Return the full filename of BOOKMARK, or nil if none.
375BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 376 (bookmark-prop-get bookmark 'filename))
e3437989
RS
377
378
379(defun bookmark-set-filename (bookmark filename)
13901bcb
KF
380 "Set the full filename of BOOKMARK to FILENAME.
381BOOKMARK may be a bookmark name (a string) or a bookmark record."
43f8b275 382 (bookmark-prop-set bookmark 'filename filename))
e3437989
RS
383
384
385(defun bookmark-get-position (bookmark)
0472835f 386 "Return the position (i.e.: point) of BOOKMARK, or nil if none.
13901bcb 387BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 388 (bookmark-prop-get bookmark 'position))
e3437989
RS
389
390
391(defun bookmark-set-position (bookmark position)
0472835f 392 "Set the position (i.e.: point) of BOOKMARK to POSITION.
13901bcb 393BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 394 (bookmark-prop-set bookmark 'position position))
e3437989
RS
395
396
397(defun bookmark-get-front-context-string (bookmark)
13901bcb
KF
398 "Return the front-context-string of BOOKMARK, or nil if none.
399BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 400 (bookmark-prop-get bookmark 'front-context-string))
e3437989
RS
401
402
403(defun bookmark-set-front-context-string (bookmark string)
13901bcb
KF
404 "Set the front-context-string of BOOKMARK to STRING.
405BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 406 (bookmark-prop-set bookmark 'front-context-string string))
e3437989
RS
407
408
409(defun bookmark-get-rear-context-string (bookmark)
13901bcb
KF
410 "Return the rear-context-string of BOOKMARK, or nil if none.
411BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 412 (bookmark-prop-get bookmark 'rear-context-string))
e3437989
RS
413
414
415(defun bookmark-set-rear-context-string (bookmark string)
13901bcb
KF
416 "Set the rear-context-string of BOOKMARK to STRING.
417BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 418 (bookmark-prop-set bookmark 'rear-context-string string))
e3437989
RS
419
420
1666a6b3 421(defun bookmark-get-handler (bookmark)
13901bcb
KF
422 "Return the handler function for BOOKMARK, or nil if none.
423BOOKMARK may be a bookmark name (a string) or a bookmark record."
02a5ba27 424 (bookmark-prop-get bookmark 'handler))
e3437989 425
4c0b5ad1
KF
426(defvar bookmark-history nil
427 "The history list for bookmark functions.")
428
429
e3437989
RS
430(defun bookmark-completing-read (prompt &optional default)
431 "Prompting with PROMPT, read a bookmark name in completion.
432PROMPT will get a \": \" stuck on the end no matter what, so you
433probably don't want to include one yourself.
434Optional second arg DEFAULT is a string to return if the user enters
435the empty string."
436 (bookmark-maybe-load-default-file) ; paranoia
175d0960 437 (if (listp last-nonmenu-event)
fd4489f0
CY
438 (bookmark-menu-popup-paned-menu t prompt
439 (if bookmark-sort-flag
440 (sort (bookmark-all-names)
441 'string-lessp)
442 (bookmark-all-names)))
175d0960
SM
443 (let* ((completion-ignore-case bookmark-completion-ignore-case)
444 (default default)
b861e45e
SM
445 (prompt (concat prompt (if default
446 (format " (%s): " default)
447 ": ")))
175d0960
SM
448 (str
449 (completing-read prompt
450 bookmark-alist
451 nil
452 0
453 nil
454 'bookmark-history)))
455 (if (string-equal "" str) default str))))
e3437989
RS
456
457
4c0b5ad1
KF
458(defmacro bookmark-maybe-historicize-string (string)
459 "Put STRING into the bookmark prompt history, if caller non-interactive.
460We need this because sometimes bookmark functions are invoked from
461menus, so `completing-read' never gets a chance to set `bookmark-history'."
dbe99ae9 462 `(or
32226619 463 (called-interactively-p 'interactive)
dbe99ae9 464 (setq bookmark-history (cons ,string bookmark-history))))
4c0b5ad1 465
43f8b275 466(defvar bookmark-make-record-function 'bookmark-make-record-default
e0385bf4
KF
467 "A function that should be called to create a bookmark record.
468Modes may set this variable buffer-locally to enable bookmarking of
469locations that should be treated specially, such as Info nodes,
470news posts, images, pdf documents, etc.
1666a6b3 471
32a091dd 472The function will be called with no arguments.
43f8b275
SM
473It should signal a user error if it is unable to construct a record for
474the current location.
136894c8
SM
475
476The returned record should be a cons cell of the form (NAME . ALIST)
477where ALIST is as described in `bookmark-alist' and may typically contain
5c1b3e94
KF
478a special cons (handler . HANDLER-FUNC) which specifies the handler function
479that should be used instead of `bookmark-default-handler' to open this
480bookmark. See the documentation for `bookmark-alist' for more.
136894c8
SM
481
482NAME is a suggested name for the constructed bookmark. It can be nil
43f8b275
SM
483in which case a default heuristic will be used. The function can also
484equivalently just return ALIST without NAME.")
136894c8
SM
485
486(defun bookmark-make-record ()
487 "Return a new bookmark record (NAME . ALIST) for the current location."
488 (let ((record (funcall bookmark-make-record-function)))
489 ;; Set up default name.
490 (if (stringp (car record))
491 ;; The function already provided a default name.
492 record
493 (if (car record) (push nil record))
494 (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))
495 record)))
496
497(defun bookmark-store (name alist no-overwrite)
498 "Store the bookmark NAME with data ALIST.
499If NO-OVERWRITE is non-nil and another bookmark of the same name already
500exists in `bookmark-alist', record the new bookmark without throwing away the
501old one."
e3437989 502 (bookmark-maybe-load-default-file)
88415bfc 503 (let ((stripped-name (copy-sequence name)))
4211e434 504 (or (featurep 'xemacs)
09fd6588
KF
505 ;; XEmacs's `set-text-properties' doesn't work on
506 ;; free-standing strings, apparently.
507 (set-text-properties 0 (length stripped-name) nil stripped-name))
2ef435bf
SM
508 (if (and (not no-overwrite)
509 (bookmark-get-bookmark stripped-name 'noerror))
3b526bae 510 ;; already existing bookmark under that name and
88415bfc 511 ;; no prefix arg means just overwrite old bookmark
43f8b275
SM
512 ;; Use the new (NAME . ALIST) format.
513 (setcdr (bookmark-get-bookmark stripped-name) alist)
dbe99ae9 514
88415bfc
KH
515 ;; otherwise just cons it onto the front (either the bookmark
516 ;; doesn't exist already, or there is no prefix arg. In either
517 ;; case, we want the new bookmark consed onto the alist...)
dbe99ae9 518
43f8b275 519 (push (cons stripped-name alist) bookmark-alist))
dbe99ae9 520
88415bfc
KH
521 ;; Added by db
522 (setq bookmark-current-bookmark stripped-name)
523 (setq bookmark-alist-modification-count
524 (1+ bookmark-alist-modification-count))
525 (if (bookmark-time-to-save-p)
136894c8 526 (bookmark-save))
e3437989 527
136894c8
SM
528 (setq bookmark-current-bookmark stripped-name)
529 (bookmark-bmenu-surreptitiously-rebuild-list)))
e3437989 530
43f8b275 531(defun bookmark-make-record-default (&optional point-only)
32a091dd 532 "Return the record describing the location of a new bookmark.
e3437989 533Must be at the correct position in the buffer in which the bookmark is
43f8b275
SM
534being set.
535If POINT-ONLY is non-nil, then only return the subset of the
536record that pertains to the location within the buffer."
537 `(,@(unless point-only `((filename . ,(bookmark-buffer-file-name))))
32a091dd
SM
538 (front-context-string
539 . ,(if (>= (- (point-max) (point)) bookmark-search-size)
540 (buffer-substring-no-properties
541 (point)
542 (+ (point) bookmark-search-size))
543 nil))
544 (rear-context-string
545 . ,(if (>= (- (point) (point-min)) bookmark-search-size)
546 (buffer-substring-no-properties
547 (point)
548 (- (point) bookmark-search-size))
549 nil))
550 (position . ,(point))))
dbe99ae9 551
e3437989
RS
552\f
553;;; File format stuff
554
7c85c02b
KF
555;; *IMPORTANT NOTICE* If you are thinking about modifying (redefining)
556;; the bookmark file format -- please don't. The current format
557;; should be extensible enough. If you feel the need to change it,
558;; please discuss it with other Emacs developers first.
559;;
560;; The format of `bookmark-alist' has changed twice in its lifetime.
561;; This comment describes the three formats, FIRST, SECOND, and
562;; CURRENT.
563;;
564;; The FIRST format was used prior to Emacs 20:
e3437989 565;;
7c85c02b 566;; ((BOOKMARK-NAME (FILENAME
185ae1f1
SM
567;; STRING-IN-FRONT
568;; STRING-BEHIND
569;; POINT))
e3437989
RS
570;; ...)
571;;
7c85c02b
KF
572;; The SECOND format was introduced in Emacs 20:
573;;
574;; ((BOOKMARK-NAME ((filename . FILENAME)
575;; (position . POS)
576;; (front-context-string . STR-AFTER-POS)
577;; (rear-context-string . STR-BEFORE-POS)
578;; (annotation . ANNOTATION)
579;; (whatever . VALUE)
580;; ...
581;; ))
582;; ...)
583;;
584;; The CURRENT format was introduced in Emacs 22:
e3437989 585;;
185ae1f1 586;; ((BOOKMARK-NAME (filename . FILENAME)
7c85c02b
KF
587;; (position . POS)
588;; (front-context-string . STR-AFTER-POS)
589;; (rear-context-string . STR-BEFORE-POS)
185ae1f1
SM
590;; (annotation . ANNOTATION)
591;; (whatever . VALUE)
592;; ...
7c85c02b 593;; )
e3437989
RS
594;; ...)
595;;
7c85c02b
KF
596;; Both FIRST and SECOND have the same level of nesting: the cadr of a
597;; bookmark record is a list of entry information. FIRST and SECOND
598;; differ in the form of the record information: FIRST uses a list of
599;; atoms, and SECOND uses an alist. In the FIRST format, the order of
600;; the list elements matters. In the SECOND format, the order of the
601;; alist elements is unimportant. The SECOND format facilitates the
602;; addition of new kinds of elements, to support new kinds of
603;; bookmarks or code evolution.
e3437989 604;;
7c85c02b
KF
605;; The CURRENT format removes a level of nesting wrt FIRST and SECOND,
606;; saving one cons cell per bookmark: the cadr of a bookmark record is
607;; no longer a cons. Why that change was made remains a mystery --
608;; just be aware of it. (Be aware too that this explanatory comment
609;; was incorrect in Emacs 22 and Emacs 23.1.)
e3437989 610;;
7c85c02b
KF
611;; To deal with the change from FIRST format to SECOND, conversion
612;; code was added, and it is still in use. See
613;; `bookmark-maybe-upgrade-file-format'.
e3437989 614;;
7c85c02b
KF
615;; No conversion from SECOND to CURRENT is done. Instead, the code
616;; handles both formats OK. It must continue to do so.
e3437989 617;;
7c85c02b
KF
618;; See the doc string of `bookmark-alist' for information about the
619;; elements that define a bookmark (e.g. `filename').
e3437989
RS
620
621
622(defconst bookmark-file-format-version 1
623 "The current version of the format used by bookmark files.
624You should never need to change this.")
625
626
627(defconst bookmark-end-of-version-stamp-marker
628 "-*- End Of Bookmark File Format Version Stamp -*-\n"
629 "This string marks the end of the version stamp in a bookmark file.")
630
631
632(defun bookmark-alist-from-buffer ()
d32ff76a 633 "Return a `bookmark-alist' (in any format) from the current buffer.
e3437989
RS
634The buffer must of course contain bookmark format information.
635Does not care from where in the buffer it is called, and does not
636affect point."
637 (save-excursion
638 (goto-char (point-min))
639 (if (search-forward bookmark-end-of-version-stamp-marker nil t)
640 (read (current-buffer))
641 ;; Else we're dealing with format version 0
642 (if (search-forward "(" nil t)
643 (progn
644 (forward-char -1)
645 (read (current-buffer)))
646 ;; Else no hope of getting information here.
a3ad20c2 647 (error "Not bookmark format")))))
e3437989
RS
648
649
650(defun bookmark-upgrade-version-0-alist (old-list)
4eadcdf8 651 "Upgrade a version 0 alist OLD-LIST to the current version."
e3437989
RS
652 (mapcar
653 (lambda (bookmark)
654 (let* ((name (car bookmark))
655 (record (car (cdr bookmark)))
656 (filename (nth 0 record))
657 (front-str (nth 1 record))
658 (rear-str (nth 2 record))
659 (position (nth 3 record))
660 (ann (nth 4 record)))
661 (list
662 name
8a946354
SS
663 `((filename . ,filename)
664 (front-context-string . ,(or front-str ""))
665 (rear-context-string . ,(or rear-str ""))
666 (position . ,position)
667 (annotation . ,ann)))))
e3437989
RS
668 old-list))
669
670
671(defun bookmark-upgrade-file-format-from-0 ()
672 "Upgrade a bookmark file of format 0 (the original format) to format 1.
d32ff76a 673This expects to be called from `point-min' in a bookmark file."
e3437989
RS
674 (message "Upgrading bookmark format from 0 to %d..."
675 bookmark-file-format-version)
676 (let* ((old-list (bookmark-alist-from-buffer))
677 (new-list (bookmark-upgrade-version-0-alist old-list)))
678 (delete-region (point-min) (point-max))
679 (bookmark-insert-file-format-version-stamp)
680 (pp new-list (current-buffer))
681 (save-buffer))
682 (goto-char (point-min))
60d0378e 683 (message "Upgrading bookmark format from 0 to %d...done"
e3437989
RS
684 bookmark-file-format-version)
685 )
686
687
688(defun bookmark-grok-file-format-version ()
689 "Return an integer which is the file-format version of this bookmark file.
d32ff76a 690This expects to be called from `point-min' in a bookmark file."
e3437989
RS
691 (if (looking-at "^;;;;")
692 (save-excursion
693 (save-match-data
694 (re-search-forward "[0-9]")
695 (forward-char -1)
696 (read (current-buffer))))
697 ;; Else this is format version 0, the original one, which didn't
698 ;; even have version stamps.
699 0))
700
701
702(defun bookmark-maybe-upgrade-file-format ()
703 "Check the file-format version of this bookmark file.
704If the version is not up-to-date, upgrade it automatically.
d32ff76a 705This expects to be called from `point-min' in a bookmark file."
e3437989
RS
706 (let ((version (bookmark-grok-file-format-version)))
707 (cond
708 ((= version bookmark-file-format-version)
709 ) ; home free -- version is current
710 ((= version 0)
711 (bookmark-upgrade-file-format-from-0))
712 (t
a3ad20c2 713 (error "Bookmark file format version strangeness")))))
e3437989
RS
714
715
716(defun bookmark-insert-file-format-version-stamp ()
5e0e5feb 717 "Insert text indicating current version of bookmark file format."
e3437989
RS
718 (insert
719 (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
720 bookmark-file-format-version))
721 (insert ";;; This format is meant to be slightly human-readable;\n"
722 ";;; nevertheless, you probably don't want to edit it.\n"
723 ";;; "
724 bookmark-end-of-version-stamp-marker))
725
726
727;;; end file-format stuff
728
729\f
9a9f1fdd
KF
730;;; Generic helpers.
731
732(defun bookmark-maybe-message (fmt &rest args)
733 "Apply `message' to FMT and ARGS, but only if the display is fast enough."
734 (if (>= baud-rate 9600)
735 (apply 'message fmt args)))
736
737\f
e3437989
RS
738;;; Core code:
739
fc22668d
SM
740(defvar bookmark-minibuffer-read-name-map
741 (let ((map (make-sparse-keymap)))
742 (set-keymap-parent map minibuffer-local-map)
743 (define-key map "\C-w" 'bookmark-yank-word)
744 ;; This C-u binding might not be very useful any more now that we
745 ;; provide access to the default via the standard M-n binding.
746 ;; Maybe we should just remove it? --Stef-08
747 (define-key map "\C-u" 'bookmark-insert-current-bookmark)
748 map))
749
d22d6453 750;;;###autoload
13901bcb 751(defun bookmark-set (&optional name no-overwrite)
825382c0 752 "Set a bookmark named NAME at the current location.
13901bcb
KF
753If name is nil, then prompt the user.
754
7c85c02b
KF
755With a prefix arg (non-nil NO-OVERWRITE), do not overwrite any
756existing bookmark that has the same name as NAME, but instead push the
757new bookmark onto the bookmark alist. The most recently set bookmark
758with name NAME is thus the one in effect at any given time, but the
759others are still there, should the user decide to delete the most
760recent one.
b3bf02fa
RS
761
762To yank words from the text of the buffer and use them as part of the
9aef3b21 763bookmark name, type C-w while setting a bookmark. Successive C-w's
b3bf02fa
RS
764yank successive words.
765
7c85c02b
KF
766Typing C-u inserts (at the bookmark name prompt) the name of the last
767bookmark used in the document where the new bookmark is being set;
768this helps you use a single bookmark name to track progress through a
769large document. If there is no prior bookmark for this document, then
770C-u inserts an appropriate name based on the buffer or file.
b3bf02fa 771
0472835f 772Use \\[bookmark-delete] to remove bookmarks (you give it a name and
7c85c02b 773it removes only the first instance of a bookmark with that name from
0472835f 774the list of bookmarks.)"
4eadcdf8 775 (interactive (list nil current-prefix-arg))
136894c8
SM
776 (let* ((record (bookmark-make-record))
777 (default (car record)))
778
779 (bookmark-maybe-load-default-file)
780
136894c8
SM
781 (setq bookmark-yank-point (point))
782 (setq bookmark-current-buffer (current-buffer))
783
784 (let ((str
785 (or name
786 (read-from-minibuffer
787 (format "Set bookmark (%s): " default)
788 nil
789 bookmark-minibuffer-read-name-map
790 nil nil default))))
791 (and (string-equal str "") (setq str default))
13901bcb 792 (bookmark-store str (cdr record) no-overwrite)
0f219a97 793
136894c8 794 ;; Ask for an annotation buffer for this bookmark
67b70de9
KF
795 (when bookmark-use-annotations
796 (bookmark-edit-annotation str)))))
e3437989
RS
797
798(defun bookmark-kill-line (&optional newline-too)
799 "Kill from point to end of line.
800If optional arg NEWLINE-TOO is non-nil, delete the newline too.
d32ff76a 801Does not affect the kill ring."
e3437989
RS
802 (let ((eol (save-excursion (end-of-line) (point))))
803 (delete-region (point) eol)
804 (if (and newline-too (looking-at "\n"))
805 (delete-char 1))))
806
807
4c0b5ad1 808;; Defvars to avoid compilation warnings:
a7e83b26
SM
809(defvar bookmark-annotation-name nil
810 "Variable holding the name of the bookmark.
811This is used in `bookmark-edit-annotation' to record the bookmark
812whose annotation is being edited.")
e3437989
RS
813
814
815(defun bookmark-default-annotation-text (bookmark)
13901bcb
KF
816 "Return default annotation text for BOOKMARK (a string, not a record).
817The default annotation text is simply some text explaining how to use
818annotations."
e3437989
RS
819 (concat "# Type the annotation for bookmark '" bookmark "' here.\n"
820 "# All lines which start with a '#' will be deleted.\n"
821 "# Type C-c C-c when done.\n#\n"
822 "# Author: " (user-full-name) " <" (user-login-name) "@"
823 (system-name) ">\n"
824 "# Date: " (current-time-string) "\n"))
825
826
a7e83b26 827(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
5e0e5feb 828 "Function to return default text to use for a bookmark annotation.
d32ff76a 829It takes one argument, the name of the bookmark, as a string.")
a7e83b26
SM
830(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
831 'bookmark-edit-annotation-text-func "23.1")
e3437989 832
a7e83b26
SM
833(defvar bookmark-edit-annotation-mode-map
834 (let ((map (make-sparse-keymap)))
835 (set-keymap-parent map text-mode-map)
836 (define-key map "\C-c\C-c" 'bookmark-send-edited-annotation)
837 map)
e3437989
RS
838 "Keymap for editing an annotation of a bookmark.")
839
840
e3437989
RS
841(defun bookmark-edit-annotation-mode (bookmark)
842 "Mode for editing the annotation of bookmark BOOKMARK.
843When you have finished composing, type \\[bookmark-send-annotation].
844
13901bcb
KF
845BOOKMARK is a bookmark name (a string) or a bookmark record.
846
1666a6b3 847\\{bookmark-edit-annotation-mode-map}"
e3437989
RS
848 (interactive)
849 (kill-all-local-variables)
850 (make-local-variable 'bookmark-annotation-name)
851 (setq bookmark-annotation-name bookmark)
852 (use-local-map bookmark-edit-annotation-mode-map)
dc5dcc00
JB
853 (setq major-mode 'bookmark-edit-annotation-mode
854 mode-name "Edit Bookmark Annotation")
a7e83b26 855 (insert (funcall bookmark-edit-annotation-text-func bookmark))
e3437989 856 (let ((annotation (bookmark-get-annotation bookmark)))
91169ba7 857 (if (and annotation (not (string-equal annotation "")))
e3437989 858 (insert annotation)))
f33cee85 859 (run-mode-hooks 'text-mode-hook))
e3437989
RS
860
861
862(defun bookmark-send-edited-annotation ()
dc5dcc00
JB
863 "Use buffer contents as annotation for a bookmark.
864Lines beginning with `#' are ignored."
e3437989
RS
865 (interactive)
866 (if (not (eq major-mode 'bookmark-edit-annotation-mode))
a3ad20c2 867 (error "Not in bookmark-edit-annotation-mode"))
e3437989
RS
868 (goto-char (point-min))
869 (while (< (point) (point-max))
870 (if (looking-at "^#")
871 (bookmark-kill-line t)
872 (forward-line 1)))
fc22668d
SM
873 ;; Take no chances with text properties.
874 (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
e3437989
RS
875 (bookmark bookmark-annotation-name))
876 (bookmark-set-annotation bookmark annotation)
b894c439
KF
877 (setq bookmark-alist-modification-count
878 (1+ bookmark-alist-modification-count))
67b70de9 879 (bookmark-bmenu-surreptitiously-rebuild-list))
e3437989
RS
880 (kill-buffer (current-buffer)))
881
882
883(defun bookmark-edit-annotation (bookmark)
13901bcb
KF
884 "Pop up a buffer for editing bookmark BOOKMARK's annotation.
885BOOKMARK is a bookmark name (a string) or a bookmark record."
175d0960
SM
886 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
887 (bookmark-edit-annotation-mode bookmark))
e3437989 888
b3bf02fa
RS
889
890(defun bookmark-insert-current-bookmark ()
6d6a5b7e
KF
891 "Insert into the bookmark name currently being set the value of
892`bookmark-current-bookmark' in `bookmark-current-buffer', defaulting
893to the buffer's file name if `bookmark-current-bookmark' is nil."
b3bf02fa
RS
894 (interactive)
895 (let ((str
fc22668d
SM
896 (with-current-buffer bookmark-current-buffer
897 (or bookmark-current-bookmark
898 (bookmark-buffer-name)))))
e3437989
RS
899 (insert str)))
900
b3bf02fa 901
4cd51172 902(defun bookmark-buffer-name ()
7c85c02b
KF
903 "Return the name of the current buffer in a form usable as a bookmark name.
904If the buffer is associated with a file or directory, use that name."
4cd51172 905 (cond
4cd51172
RS
906 ;; Or are we a file?
907 (buffer-file-name (file-name-nondirectory buffer-file-name))
908 ;; Or are we a directory?
909 ((and (boundp 'dired-directory) dired-directory)
910 (let* ((dirname (if (stringp dired-directory)
911 dired-directory
912 (car dired-directory)))
913 (idx (1- (length dirname))))
914 ;; Strip the trailing slash.
915 (if (= ?/ (aref dirname idx))
916 (file-name-nondirectory (substring dirname 0 idx))
917 ;; Else return the current-buffer
918 (buffer-name (current-buffer)))))
919 ;; If all else fails, use the buffer's name.
920 (t
921 (buffer-name (current-buffer)))))
922
923
b3bf02fa 924(defun bookmark-yank-word ()
6d6a5b7e
KF
925 "Get the next word from buffer `bookmark-current-buffer' and append
926it to the name of the bookmark currently being set, advancing
0472835f 927`bookmark-yank-point' by one word."
b3bf02fa 928 (interactive)
43f8b275
SM
929 (let ((string (with-current-buffer bookmark-current-buffer
930 (goto-char bookmark-yank-point)
931 (buffer-substring-no-properties
932 (point)
933 (progn
934 (forward-word 1)
935 (setq bookmark-yank-point (point)))))))
b3bf02fa
RS
936 (insert string)))
937
b3bf02fa 938(defun bookmark-buffer-file-name ()
d4432055 939 "Return the current buffer's file in a way useful for bookmarks."
3889f0fa
SM
940 ;; Abbreviate the path, both so it's shorter and so it's more
941 ;; portable. E.g., the user's home dir might be a different
942 ;; path on different machines, but "~/" will still reach it.
9201cc28 943 (abbreviate-file-name
3889f0fa
SM
944 (cond
945 (buffer-file-name buffer-file-name)
946 ((and (boundp 'dired-directory) dired-directory)
947 (if (stringp dired-directory)
948 dired-directory
949 (car dired-directory)))
950 (t (error "Buffer not visiting a file or directory")))))
e3437989
RS
951
952
e3437989 953(defun bookmark-maybe-load-default-file ()
13901bcb 954 "If bookmarks have not been loaded from the default place, load them."
d22d6453
RS
955 (and (not bookmarks-already-loaded)
956 (null bookmark-alist)
e3437989
RS
957 (prog2
958 (and
959 ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
960 ;; to be renamed.
fe8c0b47
SM
961 (file-exists-p bookmark-old-default-file)
962 (not (file-exists-p bookmark-default-file))
963 (rename-file bookmark-old-default-file
964 bookmark-default-file))
e3437989
RS
965 ;; return t so the `and' will continue...
966 t)
dbe99ae9 967
fe8c0b47 968 (file-readable-p bookmark-default-file)
91169ba7
RS
969 (bookmark-load bookmark-default-file t t)
970 (setq bookmarks-already-loaded t)))
d22d6453 971
e3437989 972
d22d6453 973(defun bookmark-maybe-sort-alist ()
13901bcb
KF
974 "Return `bookmark-alist' for display.
975If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist."
d22d6453 976 (if bookmark-sort-flag
1de49d4e
TTN
977 (sort (copy-alist bookmark-alist)
978 (function
979 (lambda (x y) (string-lessp (car x) (car y)))))
980 bookmark-alist))
d22d6453 981
e3437989 982
866a7257
CD
983(defvar bookmark-after-jump-hook nil
984 "Hook run after `bookmark-jump' jumps to a bookmark.
985Useful for example to unhide text in `outline-mode'.")
986
43f8b275 987(defun bookmark--jump-via (bookmark display-function)
13901bcb
KF
988 "Handle BOOKMARK, then call DISPLAY-FUNCTION with current buffer as argument.
989Bookmark may be a bookmark name (a string) or a bookmark record.
990
991After calling DISPLAY-FUNCTION, set window point to the point specified
992by BOOKMARK, if necessary, run `bookmark-after-jump-hook', and then show
993any annotations for this bookmark."
73ba5f6d 994 (bookmark-handle-bookmark bookmark)
43f8b275
SM
995 (save-current-buffer
996 (funcall display-function (current-buffer)))
997 (let ((win (get-buffer-window (current-buffer) 0)))
998 (if win (set-window-point win (point))))
999 ;; FIXME: we used to only run bookmark-after-jump-hook in
1000 ;; `bookmark-jump' itself, but in none of the other commands.
1001 (run-hooks 'bookmark-after-jump-hook)
1002 (if bookmark-automatically-show-annotations
1003 ;; if there is an annotation for this bookmark,
1004 ;; show it in a buffer.
1005 (bookmark-show-annotation bookmark)))
0f219a97 1006
43f8b275 1007
d22d6453 1008;;;###autoload
e6227f06 1009(defun bookmark-jump (bookmark &optional display-func)
dbe99ae9 1010 "Jump to bookmark BOOKMARK (a point in some file).
9aef3b21
RS
1011You may have a problem using this function if the value of variable
1012`bookmark-alist' is nil. If that happens, you need to load in some
1013bookmarks. See help on function `bookmark-load' for more about
d22d6453
RS
1014this.
1015
e3437989 1016If the file pointed to by BOOKMARK no longer exists, you will be asked
d32ff76a 1017if you wish to give the bookmark a new location, and `bookmark-jump'
e3437989 1018will then jump to the new location, as well as recording it in place
13901bcb
KF
1019of the old one in the permanent bookmark record.
1020
1021BOOKMARK may be a bookmark name (a string) or a bookmark record, but
e6227f06
KF
1022the latter is usually only used by programmatic callers.
1023
1024If DISPLAY-FUNC is non-nil, it is a function to invoke to display the
7c85c02b
KF
1025bookmark. It defaults to `switch-to-buffer'. A typical value for
1026DISPLAY-FUNC would be `switch-to-buffer-other-window'."
e3437989 1027 (interactive
175d0960
SM
1028 (list (bookmark-completing-read "Jump to bookmark"
1029 bookmark-current-bookmark)))
5d8d3a34
RS
1030 (unless bookmark
1031 (error "No bookmark specified"))
4eadcdf8 1032 (bookmark-maybe-historicize-string bookmark)
e6227f06 1033 (bookmark--jump-via bookmark (or display-func 'switch-to-buffer)))
e3437989 1034
d22d6453 1035
241ab2b5
KF
1036;;;###autoload
1037(defun bookmark-jump-other-window (bookmark)
13901bcb 1038 "Jump to BOOKMARK in another window. See `bookmark-jump' for more."
241ab2b5 1039 (interactive
e6227f06
KF
1040 (list (bookmark-completing-read "Jump to bookmark (in another window)"
1041 bookmark-current-bookmark)))
1042 (bookmark-jump bookmark 'switch-to-buffer-other-window))
241ab2b5
KF
1043
1044
79363d93 1045(defun bookmark-jump-noselect (bookmark)
73ba5f6d 1046 "Return the location pointed to by the bookmark BOOKMARK.
8f7028a8
KF
1047The return value has the form (BUFFER . POINT).
1048
13901bcb
KF
1049BOOKMARK may be a bookmark name (a string) or a bookmark record.
1050
8f7028a8 1051Note: this function is deprecated and is present for Emacs 22
0f219a97 1052compatibility only."
73ba5f6d
CY
1053 (save-excursion
1054 (bookmark-handle-bookmark bookmark)
1055 (cons (current-buffer) (point))))
1056
0f219a97
JB
1057(make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1")
1058
73ba5f6d 1059(defun bookmark-handle-bookmark (bookmark)
43f8b275 1060 "Call BOOKMARK's handler or `bookmark-default-handler' if it has none.
5feb1ba7
KF
1061BOOKMARK may be a bookmark name (a string) or a bookmark record.
1062
43f8b275 1063Changes current buffer and point and returns nil, or signals a `file-error'.
13901bcb 1064
5feb1ba7 1065If BOOKMARK has no file, this is a no-op. If BOOKMARK has a file, but
7c85c02b 1066that file no longer exists, then offer interactively to relocate BOOKMARK."
43f8b275
SM
1067 (condition-case err
1068 (funcall (or (bookmark-get-handler bookmark)
1069 'bookmark-default-handler)
1070 (bookmark-get-bookmark bookmark))
dbf8402b 1071 (bookmark-error-no-filename ;file-error
43f8b275
SM
1072 ;; We were unable to find the marked file, so ask if user wants to
1073 ;; relocate the bookmark, else remind them to consider deletion.
1074 (when (stringp bookmark)
5feb1ba7
KF
1075 ;; `bookmark' can be either a bookmark name (from `bookmark-alist')
1076 ;; or a bookmark object. If it's an object, we assume it's a
1077 ;; bookmark used internally by some other package.
1078 (let ((file (bookmark-get-filename bookmark)))
43f8b275 1079 (when file ;Don't know how to relocate if there's no `file'.
5feb1ba7
KF
1080 ;; If file is not a dir, directory-file-name just returns file.
1081 (let ((display-name (directory-file-name file)))
1082 (ding)
1083 ;; Dialog boxes can accept a file target, but usually don't
1084 ;; know how to accept a directory target (at least, this
1085 ;; is true in Gnome on GNU/Linux, and Bug#4230 says it's
1086 ;; true on Windows as well). So we suppress file dialogs
1087 ;; when relocating.
1088 (let ((use-dialog-box nil)
1089 (use-file-dialog nil))
1090 (if (y-or-n-p (concat display-name " nonexistent. Relocate \""
1091 bookmark "\"? "))
1092 (progn
1093 (bookmark-relocate bookmark)
1094 ;; Try again.
1095 (funcall (or (bookmark-get-handler bookmark)
1096 'bookmark-default-handler)
1097 (bookmark-get-bookmark bookmark)))
1098 (message
0472835f 1099 "Bookmark not relocated; consider removing it (%s)."
5feb1ba7
KF
1100 bookmark)
1101 (signal (car err) (cdr err))))))))))
43f8b275
SM
1102 ;; Added by db.
1103 (when (stringp bookmark)
1104 (setq bookmark-current-bookmark bookmark))
1105 nil)
1106
5feb1ba7
KF
1107(put 'bookmark-error-no-filename
1108 'error-conditions
1109 '(error bookmark-errors bookmark-error-no-filename))
1110(put 'bookmark-error-no-filename
1111 'error-message
1112 "Bookmark has no associated file (or directory)")
1113
13901bcb 1114(defun bookmark-default-handler (bmk-record)
43f8b275 1115 "Default handler to jump to a particular bookmark location.
13901bcb 1116BMK-RECORD is a bookmark record, not a bookmark name (i.e., not a string).
43f8b275 1117Changes current buffer and point and returns nil, or signals a `file-error'."
5feb1ba7 1118 (let ((file (bookmark-get-filename bmk-record))
dbf8402b 1119 (buf (bookmark-prop-get bmk-record 'buffer))
5feb1ba7
KF
1120 (forward-str (bookmark-get-front-context-string bmk-record))
1121 (behind-str (bookmark-get-rear-context-string bmk-record))
1122 (place (bookmark-get-position bmk-record)))
dbf8402b
SM
1123 (set-buffer
1124 (cond
1125 ((and file (file-readable-p file) (not (buffer-live-p buf)))
1126 (find-file-noselect file))
1127 ;; No file found. See if buffer BUF have been created.
1128 ((and buf (get-buffer buf)))
1129 (t ;; If not, raise error.
1130 (signal 'bookmark-error-no-filename (list 'stringp file)))))
1131 (if place (goto-char place))
1132 ;; Go searching forward first. Then, if forward-str exists and
1133 ;; was found in the file, we can search backward for behind-str.
1134 ;; Rationale is that if text was inserted between the two in the
1135 ;; file, it's better to be put before it so you can read it,
1136 ;; rather than after and remain perhaps unaware of the changes.
1137 (when (and forward-str (search-forward forward-str (point-max) t))
1138 (goto-char (match-beginning 0)))
1139 (when (and behind-str (search-backward behind-str (point-min) t))
1140 (goto-char (match-end 0)))
43f8b275 1141 nil))
d22d6453
RS
1142
1143;;;###autoload
4eadcdf8 1144(defun bookmark-relocate (bookmark)
5e0e5feb 1145 "Relocate BOOKMARK to another file (reading file name with minibuffer).
13901bcb
KF
1146BOOKMARK is a bookmark name (a string), not a bookmark record.
1147
5e0e5feb
RS
1148This makes an already existing bookmark point to that file, instead of
1149the one it used to point at. Useful when a file has been renamed
1150after a bookmark was set in it."
175d0960 1151 (interactive (list (bookmark-completing-read "Bookmark to relocate")))
4eadcdf8 1152 (bookmark-maybe-historicize-string bookmark)
e3437989 1153 (bookmark-maybe-load-default-file)
4eadcdf8 1154 (let* ((bmrk-filename (bookmark-get-filename bookmark))
fe8c0b47
SM
1155 (newloc (abbreviate-file-name
1156 (expand-file-name
1157 (read-file-name
1158 (format "Relocate %s to: " bookmark)
1159 (file-name-directory bmrk-filename))))))
91169ba7 1160 (bookmark-set-filename bookmark newloc)
43f8b275
SM
1161 (setq bookmark-alist-modification-count
1162 (1+ bookmark-alist-modification-count))
1163 (if (bookmark-time-to-save-p)
1164 (bookmark-save))
91169ba7 1165 (bookmark-bmenu-surreptitiously-rebuild-list)))
e3437989 1166
d22d6453
RS
1167
1168;;;###autoload
4eadcdf8 1169(defun bookmark-insert-location (bookmark &optional no-history)
4c0b5ad1 1170 "Insert the name of the file associated with BOOKMARK.
13901bcb
KF
1171BOOKMARK is a bookmark name (a string), not a bookmark record.
1172
4c0b5ad1
KF
1173Optional second arg NO-HISTORY means don't record this in the
1174minibuffer history list `bookmark-history'."
175d0960 1175 (interactive (list (bookmark-completing-read "Insert bookmark location")))
4eadcdf8 1176 (or no-history (bookmark-maybe-historicize-string bookmark))
7e510a5e
RS
1177 (let ((start (point)))
1178 (prog1
ebb9641f 1179 (insert (bookmark-location bookmark))
b861e45e 1180 (if (display-mouse-p)
8b1b6461
RF
1181 (add-text-properties
1182 start
1183 (save-excursion (re-search-backward
1184 "[^ \t]")
b861e45e 1185 (1+ (point)))
8b1b6461
RF
1186 '(mouse-face highlight
1187 follow-link t
1188 help-echo "mouse-2: go to this bookmark in other window"))))))
e3437989 1189
fbd98d61 1190;;;###autoload
a15269c0 1191(defalias 'bookmark-locate 'bookmark-insert-location)
e3437989 1192
4eadcdf8 1193(defun bookmark-location (bookmark)
ebb9641f 1194 "Return a description of the location of BOOKMARK.
13901bcb 1195BOOKMARK may be a bookmark name (a string) or a bookmark record."
e3437989 1196 (bookmark-maybe-load-default-file)
ebb9641f
SM
1197 ;; We could call the `handler' and ask for it to construct a description
1198 ;; dynamically: it would open up several new possibilities, but it
1199 ;; would have the major disadvantage of forcing to load each and
1200 ;; every handler when the user calls bookmark-menu.
1201 (or (bookmark-prop-get bookmark 'location)
1202 (bookmark-get-filename bookmark)
1203 "-- Unknown location --"))
e3437989 1204
d22d6453
RS
1205
1206;;;###autoload
9aef3b21 1207(defun bookmark-rename (old &optional new)
5e0e5feb
RS
1208 "Change the name of OLD bookmark to NEW name.
1209If called from keyboard, prompt for OLD and NEW. If called from
1210menubar, select OLD from a menu and prompt for NEW.
4eadcdf8 1211
13901bcb
KF
1212Both OLD and NEW are bookmark names (strings), never bookmark records.
1213
5e0e5feb 1214If called from Lisp, prompt for NEW if only OLD was passed as an
4eadcdf8
RS
1215argument. If called with two strings, then no prompting is done. You
1216must pass at least OLD when calling from Lisp.
9aef3b21
RS
1217
1218While you are entering the new name, consecutive C-w's insert
3b526bae 1219consecutive words from the text of the buffer into the new bookmark
4c0b5ad1 1220name."
175d0960 1221 (interactive (list (bookmark-completing-read "Old bookmark name")))
4c0b5ad1 1222 (bookmark-maybe-historicize-string old)
e3437989 1223 (bookmark-maybe-load-default-file)
91169ba7 1224
91169ba7
RS
1225 (setq bookmark-yank-point (point))
1226 (setq bookmark-current-buffer (current-buffer))
1227 (let ((newname
1228 (or new ; use second arg, if non-nil
1229 (read-from-minibuffer
1230 "New name: "
1231 nil
1232 (let ((now-map (copy-keymap minibuffer-local-map)))
0472835f 1233 (define-key now-map "\C-w" 'bookmark-yank-word)
91169ba7
RS
1234 now-map)
1235 nil
1236 'bookmark-history))))
1237 (bookmark-set-name old newname)
1238 (setq bookmark-current-bookmark newname)
1239 (bookmark-bmenu-surreptitiously-rebuild-list)
1240 (setq bookmark-alist-modification-count
1241 (1+ bookmark-alist-modification-count))
1242 (if (bookmark-time-to-save-p)
1243 (bookmark-save))))
b3bf02fa 1244
e3437989 1245
d22d6453 1246;;;###autoload
4eadcdf8 1247(defun bookmark-insert (bookmark)
dbe99ae9 1248 "Insert the text of the file pointed to by bookmark BOOKMARK.
13901bcb
KF
1249BOOKMARK is a bookmark name (a string), not a bookmark record.
1250
9aef3b21
RS
1251You may have a problem using this function if the value of variable
1252`bookmark-alist' is nil. If that happens, you need to load in some
1253bookmarks. See help on function `bookmark-load' for more about
8027e2ad 1254this."
175d0960 1255 (interactive (list (bookmark-completing-read "Insert bookmark contents")))
4eadcdf8 1256 (bookmark-maybe-historicize-string bookmark)
e3437989 1257 (bookmark-maybe-load-default-file)
d22d6453 1258 (let ((orig-point (point))
1666a6b3 1259 (str-to-insert
43f8b275 1260 (save-current-buffer
73ba5f6d 1261 (bookmark-handle-bookmark bookmark)
1666a6b3 1262 (buffer-string))))
d22d6453
RS
1263 (insert str-to-insert)
1264 (push-mark)
1265 (goto-char orig-point)))
1266
e3437989 1267
d22d6453 1268;;;###autoload
e3437989 1269(defun bookmark-delete (bookmark &optional batch)
dbe99ae9 1270 "Delete BOOKMARK from the bookmark list.
13901bcb
KF
1271BOOKMARK is a bookmark name (a string), not a bookmark record.
1272
9aef3b21
RS
1273Removes only the first instance of a bookmark with that name. If
1274there are one or more other bookmarks with the same name, they will
0472835f
JB
1275not be deleted. Defaults to the \"current\" bookmark (that is, the
1276one most recently used in this file, if any).
e3437989
RS
1277Optional second arg BATCH means don't update the bookmark list buffer,
1278probably because we were called from there."
1279 (interactive
175d0960
SM
1280 (list (bookmark-completing-read "Delete bookmark"
1281 bookmark-current-bookmark)))
4c0b5ad1 1282 (bookmark-maybe-historicize-string bookmark)
e3437989 1283 (bookmark-maybe-load-default-file)
2ef435bf 1284 (let ((will-go (bookmark-get-bookmark bookmark 'noerror)))
11eb4275
RS
1285 (setq bookmark-alist (delq will-go bookmark-alist))
1286 ;; Added by db, nil bookmark-current-bookmark if the last
3b526bae 1287 ;; occurrence has been deleted
2ef435bf 1288 (or (bookmark-get-bookmark bookmark-current-bookmark 'noerror)
11eb4275 1289 (setq bookmark-current-bookmark nil)))
33e97a28
KF
1290 (unless batch
1291 (bookmark-bmenu-surreptitiously-rebuild-list))
1292 (setq bookmark-alist-modification-count
1293 (1+ bookmark-alist-modification-count))
1294 (when (bookmark-time-to-save-p)
1295 (bookmark-save)))
e3437989 1296
b3bf02fa 1297
13901bcb
KF
1298(defun bookmark-time-to-save-p (&optional final-time)
1299 "Return t if it is time to save bookmarks to disk, nil otherwise.
1300Optional argument FINAL-TIME means this is being called when Emacs
1301is being killed, so save even if `bookmark-save-flag' is a number and
1302is greater than `bookmark-alist-modification-count'."
1303 ;; By Gregory M. Saunders <saunders{_AT_}cis.ohio-state.edu>
1304 (cond (final-time
b3bf02fa
RS
1305 (and (> bookmark-alist-modification-count 0)
1306 bookmark-save-flag))
1307 ((numberp bookmark-save-flag)
1308 (>= bookmark-alist-modification-count bookmark-save-flag))
1309 (t
1310 nil)))
1311
e3437989 1312
d22d6453 1313;;;###autoload
b3bf02fa 1314(defun bookmark-write ()
5e0e5feb
RS
1315 "Write bookmarks to a file (reading the file name with the minibuffer).
1316Don't use this in Lisp programs; use `bookmark-save' instead."
b3bf02fa 1317 (interactive)
e3437989 1318 (bookmark-maybe-load-default-file)
b3bf02fa
RS
1319 (bookmark-save t))
1320
e3437989 1321
d22d6453 1322;;;###autoload
dbe99ae9 1323(defun bookmark-save (&optional parg file)
9aef3b21
RS
1324 "Save currently defined bookmarks.
1325Saves by default in the file defined by the variable
4eadcdf8 1326`bookmark-default-file'. With a prefix arg, save it in file FILE
0472835f 1327\(second argument).
b3bf02fa 1328
d32ff76a
JB
1329If you are calling this from Lisp, the two arguments are PARG and
1330FILE, and if you just want it to write to the default file, then
b3bf02fa
RS
1331pass no arguments. Or pass in nil and FILE, and it will save in FILE
1332instead. If you pass in one argument, and it is non-nil, then the
1333user will be interactively queried for a file to save in.
1334
11eb4275 1335When you want to load in the bookmarks from a file, use
0472835f 1336`bookmark-load', \\[bookmark-load]. That function will prompt you
11eb4275 1337for a file, defaulting to the file defined by variable
e3437989 1338`bookmark-default-file'."
b3bf02fa 1339 (interactive "P")
e3437989 1340 (bookmark-maybe-load-default-file)
b3bf02fa
RS
1341 (cond
1342 ((and (null parg) (null file))
1343 ;;whether interactive or not, write to default file
e3437989 1344 (bookmark-write-file bookmark-default-file))
b3bf02fa
RS
1345 ((and (null parg) file)
1346 ;;whether interactive or not, write to given file
1347 (bookmark-write-file file))
1348 ((and parg (not file))
1349 ;;have been called interactively w/ prefix arg
1350 (let ((file (read-file-name "File to save bookmarks in: ")))
1351 (bookmark-write-file file)))
1352 (t ; someone called us with prefix-arg *and* a file, so just write to file
1353 (bookmark-write-file file)))
1354 ;; signal that we have synced the bookmark file by setting this to
1355 ;; 0. If there was an error at any point before, it will not get
1356 ;; set, which is what we want.
1357 (setq bookmark-alist-modification-count 0))
1358
e3437989
RS
1359
1360\f
b3bf02fa 1361(defun bookmark-write-file (file)
13901bcb 1362 "Write `bookmark-alist' to FILE."
43f8b275
SM
1363 (bookmark-maybe-message "Saving bookmarks to file %s..." file)
1364 (with-current-buffer (get-buffer-create " *Bookmarks*")
1365 (goto-char (point-min))
1366 (delete-region (point-min) (point-max))
1367 (let ((print-length nil)
1368 (print-level nil))
1369 (bookmark-insert-file-format-version-stamp)
e3f36d03
SM
1370 (insert "(")
1371 ;; Rather than a single call to `pp' we make one per bookmark.
1372 ;; Apparently `pp' has a poor algorithmic complexity, so this
1373 ;; scales a lot better. bug#4485.
0472835f 1374 (dolist (i bookmark-alist) (pp i (current-buffer)))
e3f36d03 1375 (insert ")")
43f8b275
SM
1376 (let ((version-control
1377 (cond
1378 ((null bookmark-version-control) nil)
1379 ((eq 'never bookmark-version-control) 'never)
1380 ((eq 'nospecial bookmark-version-control) version-control)
1381 (t t))))
1382 (condition-case nil
1383 (write-region (point-min) (point-max) file)
1384 (file-error (message "Can't write %s" file)))
1385 (kill-buffer (current-buffer))
1386 (bookmark-maybe-message
1387 "Saving bookmarks to file %s...done" file)))))
e3437989 1388
d22d6453 1389
91169ba7 1390(defun bookmark-import-new-list (new-list)
7c85c02b
KF
1391 "Add NEW-LIST of bookmarks to `bookmark-alist'.
1392Rename new bookmarks as needed using suffix \"<N>\" (N=1,2,3...), when
1393they conflict with existing bookmark names."
b861e45e
SM
1394 (let ((names (bookmark-all-names)))
1395 (dolist (full-record new-list)
1396 (bookmark-maybe-rename full-record names)
1397 (setq bookmark-alist (nconc bookmark-alist (list full-record)))
1398 (push (bookmark-name-from-full-record full-record) names))))
91169ba7
RS
1399
1400
1401(defun bookmark-maybe-rename (full-record names)
7c85c02b
KF
1402 "Rename bookmark FULL-RECORD if its current name is already used.
1403This is a helper for `bookmark-import-new-list'."
91169ba7
RS
1404 (let ((found-name (bookmark-name-from-full-record full-record)))
1405 (if (member found-name names)
1406 ;; We've got a conflict, so generate a new name
1407 (let ((count 2)
1408 (new-name found-name))
1409 (while (member new-name names)
1410 (setq new-name (concat found-name (format "<%d>" count)))
1411 (setq count (1+ count)))
1412 (bookmark-set-name full-record new-name)))))
1413
1414
d22d6453 1415;;;###autoload
91169ba7 1416(defun bookmark-load (file &optional overwrite no-msg)
9aef3b21
RS
1417 "Load bookmarks from FILE (which must be in bookmark format).
1418Appends loaded bookmarks to the front of the list of bookmarks. If
91169ba7 1419optional second argument OVERWRITE is non-nil, existing bookmarks are
9aef3b21
RS
1420destroyed. Optional third arg NO-MSG means don't display any messages
1421while loading.
b3bf02fa
RS
1422
1423If you load a file that doesn't contain a proper bookmark alist, you
9aef3b21 1424will corrupt Emacs's bookmark list. Generally, you should only load
b3bf02fa 1425in files that were created with the bookmark functions in the first
e3437989 1426place. Your own personal bookmark file, `~/.emacs.bmk', is
8027e2ad 1427maintained automatically by Emacs; you shouldn't need to load it
91169ba7
RS
1428explicitly.
1429
1430If you load a file containing bookmarks with the same names as
1431bookmarks already present in your Emacs, the new bookmarks will get
1432unique numeric suffixes \"<2>\", \"<3>\", ... following the same
1433method buffers use to resolve name collisions."
b3bf02fa 1434 (interactive
e3437989
RS
1435 (list (read-file-name
1436 (format "Load bookmarks from: (%s) "
dbe99ae9 1437 bookmark-default-file)
e3437989
RS
1438 ;;Default might not be used often,
1439 ;;but there's no better default, and
1440 ;;I guess it's better than none at all.
1441 "~/" bookmark-default-file 'confirm)))
fe8c0b47 1442 (setq file (abbreviate-file-name (expand-file-name file)))
43f8b275
SM
1443 (if (not (file-readable-p file))
1444 (error "Cannot read bookmark file %s" file)
1445 (if (null no-msg)
1446 (bookmark-maybe-message "Loading bookmarks from %s..." file))
1447 (with-current-buffer (let ((enable-local-variables nil))
1448 (find-file-noselect file))
1449 (goto-char (point-min))
1450 (bookmark-maybe-upgrade-file-format)
1451 (let ((blist (bookmark-alist-from-buffer)))
1452 (if (listp blist)
1453 (progn
1454 (if overwrite
1455 (progn
1456 (setq bookmark-alist blist)
1457 (setq bookmark-alist-modification-count 0))
1458 ;; else
1459 (bookmark-import-new-list blist)
1460 (setq bookmark-alist-modification-count
1461 (1+ bookmark-alist-modification-count)))
1462 (if (string-equal
fe8c0b47
SM
1463 (abbreviate-file-name
1464 (expand-file-name bookmark-default-file))
43f8b275
SM
1465 file)
1466 (setq bookmarks-already-loaded t))
1467 (bookmark-bmenu-surreptitiously-rebuild-list))
1468 (error "Invalid bookmark list in %s" file)))
1469 (kill-buffer (current-buffer)))
1470 (if (null no-msg)
1471 (bookmark-maybe-message "Loading bookmarks from %s...done" file))))
b3bf02fa 1472
d22d6453 1473
e3437989 1474\f
43f8b275
SM
1475;;; Code supporting the dired-like bookmark menu.
1476;; Prefix is "bookmark-bmenu" for "buffer-menu":
e3437989
RS
1477
1478
e3437989
RS
1479(defvar bookmark-bmenu-hidden-bookmarks ())
1480
1481
b861e45e
SM
1482(defvar bookmark-bmenu-mode-map
1483 (let ((map (make-keymap)))
1484 (suppress-keymap map t)
1485 (define-key map "q" 'quit-window)
1486 (define-key map "v" 'bookmark-bmenu-select)
1487 (define-key map "w" 'bookmark-bmenu-locate)
1488 (define-key map "2" 'bookmark-bmenu-2-window)
1489 (define-key map "1" 'bookmark-bmenu-1-window)
1490 (define-key map "j" 'bookmark-bmenu-this-window)
1491 (define-key map "\C-c\C-c" 'bookmark-bmenu-this-window)
1492 (define-key map "f" 'bookmark-bmenu-this-window)
1493 (define-key map "\C-m" 'bookmark-bmenu-this-window)
1494 (define-key map "o" 'bookmark-bmenu-other-window)
1495 (define-key map "\C-o" 'bookmark-bmenu-switch-other-window)
1496 (define-key map "s" 'bookmark-bmenu-save)
1497 (define-key map "k" 'bookmark-bmenu-delete)
1498 (define-key map "\C-d" 'bookmark-bmenu-delete-backwards)
1499 (define-key map "x" 'bookmark-bmenu-execute-deletions)
1500 (define-key map "d" 'bookmark-bmenu-delete)
1501 (define-key map " " 'next-line)
1502 (define-key map "n" 'next-line)
1503 (define-key map "p" 'previous-line)
1504 (define-key map "\177" 'bookmark-bmenu-backup-unmark)
1505 (define-key map "?" 'describe-mode)
1506 (define-key map "u" 'bookmark-bmenu-unmark)
1507 (define-key map "m" 'bookmark-bmenu-mark)
1508 (define-key map "l" 'bookmark-bmenu-load)
1509 (define-key map "r" 'bookmark-bmenu-rename)
1510 (define-key map "R" 'bookmark-bmenu-relocate)
1511 (define-key map "t" 'bookmark-bmenu-toggle-filenames)
1512 (define-key map "a" 'bookmark-bmenu-show-annotation)
1513 (define-key map "A" 'bookmark-bmenu-show-all-annotations)
1514 (define-key map "e" 'bookmark-bmenu-edit-annotation)
26d9285f
SM
1515 ;; The original binding of M-g hides the M-g prefix map.
1516 ;; If someone has a better idea than M-g s, I'm open to suggestions.
1517 (define-key map [?\M-g ?s] 'bookmark-bmenu-search)
b861e45e
SM
1518 (define-key map [mouse-2] 'bookmark-bmenu-other-window-with-mouse)
1519 map))
e3437989
RS
1520
1521;; Bookmark Buffer Menu mode is suitable only for specially formatted
1522;; data.
1523(put 'bookmark-bmenu-mode 'mode-class 'special)
1524
1525
1526;; todo: need to display whether or not bookmark exists as a buffer in
dbe99ae9 1527;; flag column.
d22d6453
RS
1528
1529;; Format:
e3437989
RS
1530;; FLAGS BOOKMARK [ LOCATION ]
1531
1532
1533(defun bookmark-bmenu-surreptitiously-rebuild-list ()
1534 "Rebuild the Bookmark List if it exists.
1535Don't affect the buffer ring order."
1536 (if (get-buffer "*Bookmark List*")
1537 (save-excursion
dbe99ae9 1538 (save-window-excursion
e3437989 1539 (bookmark-bmenu-list)))))
d22d6453 1540
d22d6453
RS
1541
1542;;;###autoload
e3437989 1543(defun bookmark-bmenu-list ()
d22d6453
RS
1544 "Display a list of existing bookmarks.
1545The list is displayed in a buffer named `*Bookmark List*'.
e3437989
RS
1546The leftmost column displays a D if the bookmark is flagged for
1547deletion, or > if it is flagged for displaying."
d22d6453 1548 (interactive)
e3437989 1549 (bookmark-maybe-load-default-file)
955ef430
SM
1550 (let ((buf (get-buffer-create "*Bookmark List*")))
1551 (if (called-interactively-p 'interactive)
1552 (if (or (window-dedicated-p) (window-minibuffer-p))
1553 (pop-to-buffer buf)
1554 (switch-to-buffer buf))
1555 (set-buffer buf)))
175d0960
SM
1556 (let ((inhibit-read-only t))
1557 (erase-buffer)
d22d6453 1558 (insert "% Bookmark\n- --------\n")
37789292
RF
1559 (add-text-properties (point-min) (point)
1560 '(font-lock-face bookmark-menu-heading))
b861e45e 1561 (dolist (full-record (bookmark-maybe-sort-alist))
fc9d6ad6
SM
1562 (let ((name (bookmark-name-from-full-record full-record))
1563 (annotation (bookmark-get-annotation full-record))
1564 (start (point))
1565 end)
1566 ;; if a bookmark has an annotation, prepend a "*"
1567 ;; in the list of bookmarks.
b861e45e 1568 (insert (if (and annotation (not (string-equal annotation "")))
fc9d6ad6
SM
1569 " *" " ")
1570 name)
1571 (setq end (point))
54136282
KF
1572 (put-text-property
1573 (+ bookmark-bmenu-marks-width start) end 'bookmark-name-prop name)
fc9d6ad6
SM
1574 (when (display-mouse-p)
1575 (add-text-properties
54136282 1576 (+ bookmark-bmenu-marks-width start) end
fc9d6ad6
SM
1577 '(mouse-face highlight
1578 follow-link t
1579 help-echo "mouse-2: go to this bookmark in other window")))
1580 (insert "\n")))
b894c439 1581 (set-buffer-modified-p (not (= bookmark-alist-modification-count 0)))
fc9d6ad6
SM
1582 (goto-char (point-min))
1583 (forward-line 2)
1584 (bookmark-bmenu-mode)
1585 (if bookmark-bmenu-toggle-filenames
1586 (bookmark-bmenu-toggle-filenames t))))
e3437989
RS
1587
1588;;;###autoload
1589(defalias 'list-bookmarks 'bookmark-bmenu-list)
1590;;;###autoload
1591(defalias 'edit-bookmarks 'bookmark-bmenu-list)
d22d6453 1592
e3437989
RS
1593
1594
1595(defun bookmark-bmenu-mode ()
d22d6453
RS
1596 "Major mode for editing a list of bookmarks.
1597Each line describes one of the bookmarks in Emacs.
1598Letters do not insert themselves; instead, they are commands.
3b526bae 1599Bookmark names preceded by a \"*\" have annotations.
e3437989
RS
1600\\<bookmark-bmenu-mode-map>
1601\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
1602\\[bookmark-bmenu-select] -- select bookmark of line point is on.
1603 Also show bookmarks marked using m in other windows.
1604\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
1605\\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
1606\\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window.
1607\\[bookmark-bmenu-2-window] -- select this bookmark in one window,
d22d6453 1608 together with bookmark selected before this one in another window.
e3437989
RS
1609\\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer.
1610\\[bookmark-bmenu-other-window] -- select this bookmark in another window,
d22d6453 1611 so the bookmark menu bookmark remains visible in its window.
e3437989 1612\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
0472835f
JB
1613\\[bookmark-bmenu-rename] -- rename this bookmark (prompts for new name).
1614\\[bookmark-bmenu-relocate] -- relocate this bookmark's file (prompts for new file).
e3437989 1615\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
dbe99ae9 1616\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
60d0378e 1617\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
e3437989 1618\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
d22d6453 1619 With a prefix arg, prompts for a file to save in.
e3437989
RS
1620\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
1621\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
d22d6453 1622 With prefix argument, also move up one line.
e3437989
RS
1623\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
1624\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
1625 in another buffer.
1626\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
1627\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
d22d6453 1628 (kill-all-local-variables)
e3437989 1629 (use-local-map bookmark-bmenu-mode-map)
d22d6453
RS
1630 (setq truncate-lines t)
1631 (setq buffer-read-only t)
e3437989 1632 (setq major-mode 'bookmark-bmenu-mode)
d22d6453 1633 (setq mode-name "Bookmark Menu")
f33cee85 1634 (run-mode-hooks 'bookmark-bmenu-mode-hook))
d22d6453 1635
e3437989 1636
4eadcdf8 1637(defun bookmark-bmenu-toggle-filenames (&optional show)
d22d6453
RS
1638 "Toggle whether filenames are shown in the bookmark list.
1639Optional argument SHOW means show them unconditionally."
1640 (interactive)
1641 (cond
4eadcdf8 1642 (show
e3437989
RS
1643 (setq bookmark-bmenu-toggle-filenames nil)
1644 (bookmark-bmenu-show-filenames)
1645 (setq bookmark-bmenu-toggle-filenames t))
1646 (bookmark-bmenu-toggle-filenames
1647 (bookmark-bmenu-hide-filenames)
1648 (setq bookmark-bmenu-toggle-filenames nil))
d22d6453 1649 (t
e3437989
RS
1650 (bookmark-bmenu-show-filenames)
1651 (setq bookmark-bmenu-toggle-filenames t))))
1652
d22d6453 1653
e3437989 1654(defun bookmark-bmenu-show-filenames (&optional force)
13901bcb 1655 "In an interactive bookmark list, show filenames along with bookmarks.
7c85c02b
KF
1656Non-nil FORCE forces a redisplay showing the filenames. FORCE is used
1657mainly for debugging, and should not be necessary in normal use."
e3437989 1658 (if (and (not force) bookmark-bmenu-toggle-filenames)
d22d6453 1659 nil ;already shown, so do nothing
b894c439
KF
1660 (with-buffer-modified-unmodified
1661 (save-excursion
1662 (save-window-excursion
1663 (goto-char (point-min))
1664 (forward-line 2)
1665 (setq bookmark-bmenu-hidden-bookmarks ())
1666 (let ((inhibit-read-only t))
1667 (while (< (point) (point-max))
1668 (let ((bmrk (bookmark-bmenu-bookmark)))
1669 (push bmrk bookmark-bmenu-hidden-bookmarks)
1670 (let ((start (save-excursion (end-of-line) (point))))
1671 (move-to-column bookmark-bmenu-file-column t)
1672 ;; Strip off `mouse-face' from the white spaces region.
1673 (if (display-mouse-p)
1674 (remove-text-properties start (point)
1675 '(mouse-face nil help-echo nil))))
1676 (delete-region (point) (progn (end-of-line) (point)))
1677 (insert " ")
1678 ;; Pass the NO-HISTORY arg:
1679 (bookmark-insert-location bmrk t)
1680 (forward-line 1)))))))))
d22d6453 1681
e3437989
RS
1682
1683(defun bookmark-bmenu-hide-filenames (&optional force)
13901bcb 1684 "In an interactive bookmark list, hide the filenames of the bookmarks.
7c85c02b
KF
1685Non-nil FORCE forces a redisplay showing the filenames. FORCE is used
1686mainly for debugging, and should not be necessary in normal use."
fc9d6ad6
SM
1687 (when (and (not force) bookmark-bmenu-toggle-filenames)
1688 ;; nothing to hide if above is nil
b894c439
KF
1689 (with-buffer-modified-unmodified
1690 (save-excursion
1691 (goto-char (point-min))
1692 (forward-line 2)
1693 (setq bookmark-bmenu-hidden-bookmarks
1694 (nreverse bookmark-bmenu-hidden-bookmarks))
1695 (let ((inhibit-read-only t))
1696 (while bookmark-bmenu-hidden-bookmarks
54136282 1697 (move-to-column bookmark-bmenu-marks-width t)
b894c439
KF
1698 (bookmark-kill-line)
1699 (let ((name (pop bookmark-bmenu-hidden-bookmarks))
1700 (start (point)))
1701 (insert name)
54136282 1702 (put-text-property start (point) 'bookmark-name-prop name)
b894c439
KF
1703 (if (display-mouse-p)
1704 (add-text-properties
1705 start (point)
1706 '(mouse-face
1707 highlight follow-link t help-echo
1708 "mouse-2: go to this bookmark in other window"))))
1709 (forward-line 1)))))))
d22d6453 1710
e3437989 1711
aef053eb 1712(defun bookmark-bmenu-ensure-position ()
7c85c02b 1713 "If point is not on a bookmark line, move it to one.
aef053eb
KF
1714If before the first bookmark line, move to the first; if after the
1715last full line, move to the last full line. The return value is undefined."
1716 (cond ((< (count-lines (point-min) (point)) bookmark-bmenu-header-height)
d22d6453 1717 (goto-char (point-min))
aef053eb 1718 (forward-line bookmark-bmenu-header-height))
d22d6453 1719 ((and (bolp) (eobp))
aef053eb 1720 (beginning-of-line 0))))
d22d6453 1721
e3437989
RS
1722
1723(defun bookmark-bmenu-bookmark ()
13901bcb 1724 "Return the bookmark for this line in an interactive bookmark list buffer."
aef053eb 1725 (bookmark-bmenu-ensure-position)
5ae329f4
KF
1726 (save-excursion
1727 (beginning-of-line)
1728 (forward-char bookmark-bmenu-marks-width)
1729 (get-text-property (point) 'bookmark-name-prop)))
d22d6453 1730
e3437989
RS
1731
1732(defun bookmark-show-annotation (bookmark)
1733 "Display the annotation for bookmark named BOOKMARK in a buffer,
1734if an annotation exists."
1735 (let ((annotation (bookmark-get-annotation bookmark)))
0c4371fe
KF
1736 (when (and annotation (not (string-equal annotation "")))
1737 (save-excursion
1738 (let ((old-buf (current-buffer)))
1739 (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1740 (delete-region (point-min) (point-max))
1741 ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
1742 (insert annotation)
1743 (goto-char (point-min))
1744 (switch-to-buffer-other-window old-buf))))))
e3437989
RS
1745
1746
1747(defun bookmark-show-all-annotations ()
1748 "Display the annotations for all bookmarks in a buffer."
b861e45e 1749 (save-selected-window
e3437989
RS
1750 (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1751 (delete-region (point-min) (point-max))
b861e45e
SM
1752 (dolist (full-record bookmark-alist)
1753 (let* ((name (bookmark-name-from-full-record full-record))
1754 (ann (bookmark-get-annotation full-record)))
1755 (insert (concat name ":\n"))
1756 (if (and ann (not (string-equal ann "")))
1757 ;; insert the annotation, indented by 4 spaces.
1758 (progn
1759 (save-excursion (insert ann) (unless (bolp)
1760 (insert "\n")))
1761 (while (< (point) (point-max))
1762 (beginning-of-line) ; paranoia
1763 (insert " ")
1764 (forward-line)
1765 (end-of-line))))))
1766 (goto-char (point-min))))
e3437989
RS
1767
1768
1769(defun bookmark-bmenu-mark ()
5e0e5feb 1770 "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
d22d6453
RS
1771 (interactive)
1772 (beginning-of-line)
aef053eb 1773 (bookmark-bmenu-ensure-position)
b894c439
KF
1774 (with-buffer-modified-unmodified
1775 (let ((inhibit-read-only t))
1776 (delete-char 1)
1777 (insert ?>)
1778 (forward-line 1)
1779 (bookmark-bmenu-ensure-position))))
d22d6453 1780
e3437989
RS
1781
1782(defun bookmark-bmenu-select ()
d22d6453 1783 "Select this line's bookmark; also display bookmarks marked with `>'.
e3437989 1784You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
d22d6453 1785 (interactive)
aef053eb
KF
1786 (let ((bmrk (bookmark-bmenu-bookmark))
1787 (menu (current-buffer))
1788 (others ())
1789 tem)
1790 (goto-char (point-min))
1791 (while (re-search-forward "^>" nil t)
1792 (setq tem (bookmark-bmenu-bookmark))
1793 (let ((inhibit-read-only t))
1794 (delete-char -1)
1795 (insert ?\s))
1796 (or (string-equal tem bmrk)
1797 (member tem others)
1798 (setq others (cons tem others))))
1799 (setq others (nreverse others)
1800 tem (/ (1- (frame-height)) (1+ (length others))))
1801 (delete-other-windows)
1802 (bookmark-jump bmrk)
1803 (bury-buffer menu)
1804 (if others
1805 (while others
1806 (split-window nil tem)
1807 (other-window 1)
1808 (bookmark-jump (car others))
1809 (setq others (cdr others)))
1810 (other-window 1))))
d22d6453 1811
e3437989 1812
47989945
KF
1813(defun bookmark-bmenu-any-marks ()
1814 "Return non-nil if any bookmarks are marked in the marks column."
1815 (save-excursion
1816 (goto-char (point-min))
1817 (bookmark-bmenu-ensure-position)
1818 (catch 'found-mark
1819 (while (not (eobp))
1820 (beginning-of-line)
1821 (if (looking-at "^\\S-")
1822 (throw 'found-mark t)
1823 (forward-line 1)))
1824 nil)))
1825
1826
e3437989 1827(defun bookmark-bmenu-save (parg)
d22d6453
RS
1828 "Save the current list into a bookmark file.
1829With a prefix arg, prompts for a file to save them in."
1830 (interactive "P")
1831 (save-excursion
1832 (save-window-excursion
cc4d3cad
KF
1833 (bookmark-save parg)
1834 (set-buffer-modified-p nil))))
d22d6453 1835
e3437989
RS
1836
1837(defun bookmark-bmenu-load ()
1838 "Load the bookmark file and rebuild the bookmark menu-buffer."
d22d6453 1839 (interactive)
aef053eb
KF
1840 (bookmark-bmenu-ensure-position)
1841 (save-excursion
1842 (save-window-excursion
1843 ;; This will call `bookmark-bmenu-list'
1844 (call-interactively 'bookmark-load))))
d22d6453 1845
e3437989
RS
1846
1847(defun bookmark-bmenu-1-window ()
d22d6453
RS
1848 "Select this line's bookmark, alone, in full frame."
1849 (interactive)
aef053eb
KF
1850 (bookmark-jump (bookmark-bmenu-bookmark))
1851 (bury-buffer (other-buffer))
1852 (delete-other-windows))
d22d6453 1853
e3437989
RS
1854
1855(defun bookmark-bmenu-2-window ()
d22d6453
RS
1856 "Select this line's bookmark, with previous buffer in second window."
1857 (interactive)
aef053eb
KF
1858 (let ((bmrk (bookmark-bmenu-bookmark))
1859 (menu (current-buffer))
1860 (pop-up-windows t))
1861 (delete-other-windows)
1862 (switch-to-buffer (other-buffer))
5b98e31f 1863 (bookmark--jump-via bmrk 'pop-to-buffer)
aef053eb 1864 (bury-buffer menu)))
d22d6453 1865
e3437989
RS
1866
1867(defun bookmark-bmenu-this-window ()
d22d6453
RS
1868 "Select this line's bookmark in this window."
1869 (interactive)
aef053eb 1870 (bookmark-jump (bookmark-bmenu-bookmark)))
d22d6453 1871
e3437989
RS
1872
1873(defun bookmark-bmenu-other-window ()
d22d6453
RS
1874 "Select this line's bookmark in other window, leaving bookmark menu visible."
1875 (interactive)
e3437989 1876 (let ((bookmark (bookmark-bmenu-bookmark)))
5b98e31f 1877 (bookmark--jump-via bookmark 'switch-to-buffer-other-window)))
e40e3151
KF
1878
1879
1880(defun bookmark-bmenu-switch-other-window ()
1881 "Make the other window select this line's bookmark.
1882The current window remains selected."
1883 (interactive)
e197b151
RS
1884 (let ((bookmark (bookmark-bmenu-bookmark))
1885 (pop-up-windows t)
dbe99ae9 1886 same-window-buffer-names
e197b151 1887 same-window-regexps)
5b98e31f 1888 (bookmark--jump-via bookmark 'display-buffer)))
e3437989 1889
7e510a5e
RS
1890(defun bookmark-bmenu-other-window-with-mouse (event)
1891 "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
1892 (interactive "e")
43f8b275 1893 (with-current-buffer (window-buffer (posn-window (event-end event)))
7e510a5e
RS
1894 (save-excursion
1895 (goto-char (posn-point (event-end event)))
1896 (bookmark-bmenu-other-window))))
1897
e3437989
RS
1898
1899(defun bookmark-bmenu-show-annotation ()
1900 "Show the annotation for the current bookmark in another window."
1901 (interactive)
1902 (let ((bookmark (bookmark-bmenu-bookmark)))
aef053eb 1903 (bookmark-show-annotation bookmark)))
d22d6453 1904
e3437989
RS
1905
1906(defun bookmark-bmenu-show-all-annotations ()
1907 "Show the annotation for all bookmarks in another window."
1908 (interactive)
1909 (bookmark-show-all-annotations))
1910
1911
1912(defun bookmark-bmenu-edit-annotation ()
1913 "Edit the annotation for the current bookmark in another window."
1914 (interactive)
1915 (let ((bookmark (bookmark-bmenu-bookmark)))
aef053eb 1916 (bookmark-edit-annotation bookmark)))
e3437989
RS
1917
1918
e3437989 1919(defun bookmark-bmenu-unmark (&optional backup)
d22d6453 1920 "Cancel all requested operations on bookmark on this line and move down.
4eadcdf8 1921Optional BACKUP means move up."
d22d6453
RS
1922 (interactive "P")
1923 (beginning-of-line)
aef053eb 1924 (bookmark-bmenu-ensure-position)
b894c439
KF
1925 (with-buffer-modified-unmodified
1926 (let ((inhibit-read-only t))
1927 (delete-char 1)
1928 ;; any flags to reset according to circumstances? How about a
1929 ;; flag indicating whether this bookmark is being visited?
1930 ;; well, we don't have this now, so maybe later.
1931 (insert " "))
1932 (forward-line (if backup -1 1))
1933 (bookmark-bmenu-ensure-position)))
d22d6453 1934
e3437989
RS
1935
1936(defun bookmark-bmenu-backup-unmark ()
d22d6453
RS
1937 "Move up and cancel all requested operations on bookmark on line above."
1938 (interactive)
1939 (forward-line -1)
aef053eb
KF
1940 (bookmark-bmenu-ensure-position)
1941 (bookmark-bmenu-unmark)
1942 (forward-line -1)
1943 (bookmark-bmenu-ensure-position))
d22d6453 1944
e3437989
RS
1945
1946(defun bookmark-bmenu-delete ()
5e0e5feb
RS
1947 "Mark bookmark on this line to be deleted.
1948To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
d22d6453
RS
1949 (interactive)
1950 (beginning-of-line)
aef053eb 1951 (bookmark-bmenu-ensure-position)
b894c439
KF
1952 (with-buffer-modified-unmodified
1953 (let ((inhibit-read-only t))
1954 (delete-char 1)
1955 (insert ?D)
1956 (forward-line 1)
1957 (bookmark-bmenu-ensure-position))))
d22d6453 1958
e3437989
RS
1959
1960(defun bookmark-bmenu-delete-backwards ()
5e0e5feb
RS
1961 "Mark bookmark on this line to be deleted, then move up one line.
1962To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
d22d6453 1963 (interactive)
e3437989 1964 (bookmark-bmenu-delete)
d22d6453 1965 (forward-line -2)
aef053eb
KF
1966 (bookmark-bmenu-ensure-position)
1967 (forward-line 1)
1968 (bookmark-bmenu-ensure-position))
d22d6453 1969
e3437989
RS
1970
1971(defun bookmark-bmenu-execute-deletions ()
38bee102 1972 "Delete bookmarks flagged `D'."
d22d6453 1973 (interactive)
60d0378e 1974 (message "Deleting bookmarks...")
fc9d6ad6 1975 (let ((o-point (point))
e3437989
RS
1976 (o-str (save-excursion
1977 (beginning-of-line)
fc9d6ad6 1978 (unless (looking-at "^D")
e3437989
RS
1979 (buffer-substring
1980 (point)
1981 (progn (end-of-line) (point))))))
1982 (o-col (current-column)))
d22d6453
RS
1983 (goto-char (point-min))
1984 (forward-line 1)
e3437989
RS
1985 (while (re-search-forward "^D" (point-max) t)
1986 (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
1987 (bookmark-bmenu-list)
e3437989
RS
1988 (if o-str
1989 (progn
1990 (goto-char (point-min))
1991 (search-forward o-str)
1992 (beginning-of-line)
1993 (forward-char o-col))
1994 (goto-char o-point))
1995 (beginning-of-line)
60d0378e
KF
1996 (message "Deleting bookmarks...done")
1997 ))
e3437989
RS
1998
1999
2000(defun bookmark-bmenu-rename ()
d22d6453
RS
2001 "Rename bookmark on current line. Prompts for a new name."
2002 (interactive)
aef053eb
KF
2003 (let ((bmrk (bookmark-bmenu-bookmark))
2004 (thispoint (point)))
2005 (bookmark-rename bmrk)
2006 (goto-char thispoint)))
d22d6453 2007
e3437989
RS
2008
2009(defun bookmark-bmenu-locate ()
d22d6453
RS
2010 "Display location of this bookmark. Displays in the minibuffer."
2011 (interactive)
3a69db53
KF
2012 (let ((bmrk (bookmark-bmenu-bookmark)))
2013 (message "%s" (bookmark-location bmrk))))
e3437989 2014
037b0a87
KF
2015(defun bookmark-bmenu-relocate ()
2016 "Change the file path of the bookmark on the current line,
2017 prompting with completion for the new path."
2018 (interactive)
aef053eb
KF
2019 (let ((bmrk (bookmark-bmenu-bookmark))
2020 (thispoint (point)))
2021 (bookmark-relocate bmrk)
2022 (goto-char thispoint)))
d22d6453 2023
1e7d4475
SM
2024;;; Bookmark-bmenu search
2025
26d9285f
SM
2026;; Store keyboard input for incremental search.
2027(defvar bookmark-search-pattern)
2028
1e7d4475
SM
2029(defun bookmark-read-search-input ()
2030 "Read each keyboard input and add it to `bookmark-search-pattern'."
26d9285f
SM
2031 (let ((prompt (propertize "Pattern: " 'face 'minibuffer-prompt))
2032 ;; (inhibit-quit t) ; inhibit-quit is evil. Use it with extreme care!
2033 (tmp-list ()))
2034 (while
2035 (let ((char (read-key (concat prompt bookmark-search-pattern))))
1e7d4475 2036 (case char
26d9285f
SM
2037 ((?\e ?\r) nil) ; RET or ESC break the search loop.
2038 (?\C-g (setq bookmark-quit-flag t) nil)
2039 (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
1e7d4475 2040 (t
26d9285f
SM
2041 (if (characterp char)
2042 (push char tmp-list)
2043 (setq unread-command-events
2044 (nconc (mapcar 'identity
2045 (this-single-command-raw-keys))
2046 unread-command-events))
2047 nil))))
2048 (setq bookmark-search-pattern
2049 (apply 'string (reverse tmp-list))))))
1e7d4475
SM
2050
2051
2052(defun bookmark-bmenu-filter-alist-by-regexp (regexp)
2053 "Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
26d9285f
SM
2054 (let ((bookmark-alist
2055 (loop for i in bookmark-alist
2056 when (string-match regexp (car i)) collect i into new
2057 finally return new)))
1e7d4475
SM
2058 (bookmark-bmenu-list)))
2059
26d9285f 2060
1e7d4475
SM
2061;;;###autoload
2062(defun bookmark-bmenu-search ()
26d9285f 2063 "Incremental search of bookmarks, hiding the non-matches as we go."
1e7d4475 2064 (interactive)
26d9285f
SM
2065 (let ((bmk (bookmark-bmenu-bookmark))
2066 (bookmark-search-pattern "")
2067 (timer (run-with-idle-timer
2068 bookmark-search-delay 'repeat
2069 #'(lambda ()
2070 (bookmark-bmenu-filter-alist-by-regexp
2071 bookmark-search-pattern)))))
2072 (unwind-protect
2073 (bookmark-read-search-input)
2074 (cancel-timer timer)
83505cfe 2075 (message nil)
26d9285f
SM
2076 (when bookmark-quit-flag ; C-g hit restore menu list.
2077 (bookmark-bmenu-list) (bookmark-bmenu-goto-bookmark bmk))
2078 (setq bookmark-quit-flag nil))))
0472835f 2079
1e7d4475
SM
2080(defun bookmark-bmenu-goto-bookmark (name)
2081 "Move point to bookmark with name NAME."
2082 (goto-char (point-min))
1e7d4475
SM
2083 (while (not (equal name (bookmark-bmenu-bookmark)))
2084 (forward-line 1))
2085 (forward-line 0))
0472835f 2086
1e7d4475 2087
e3437989
RS
2088\f
2089;;; Menu bar stuff. Prefix is "bookmark-menu".
11eb4275 2090
e3437989
RS
2091(defun bookmark-menu-popup-paned-menu (event name entries)
2092 "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
2093That is, ENTRIES is a list of strings which appear as the choices
2094in the menu.
175d0960
SM
2095The number of panes depends on the number of entries.
2096The visible entries are truncated to `bookmark-menu-length', but the
2097strings returned are not."
2098 (let ((f-height (/ (frame-height) 2))
2099 (pane-list nil)
2100 (iter 0))
2101 (while entries
2102 (let (lst
2103 (count 0))
2104 (while (and (< count f-height) entries)
2105 (let ((str (car entries)))
2106 (push (cons
2107 (if (> (length str) bookmark-menu-length)
2108 (substring str 0 bookmark-menu-length)
2109 str)
2110 str)
2111 lst)
2112 (setq entries (cdr entries))
2113 (setq count (1+ count))))
2114 (setq iter (1+ iter))
2115 (push (cons
2116 (format "-*- %s (%d) -*-" name iter)
2117 (nreverse lst))
2118 pane-list)))
d32ff76a 2119
175d0960
SM
2120 ;; Popup the menu and return the string.
2121 (x-popup-menu event (cons (concat "-*- " name " -*-")
2122 (nreverse pane-list)))))
e3437989 2123
b3bf02fa 2124
d22d6453
RS
2125;; Thanks to Roland McGrath for fixing menubar.el so that the
2126;; following works, and for explaining what to do to make it work.
b3bf02fa 2127
7af04c89
RS
2128;; We MUST autoload EACH form used to set up this variable's value, so
2129;; that the whole job is done in loaddefs.el.
b3bf02fa 2130
5e0e5feb 2131;; Emacs menubar stuff.
09fd6588 2132
7af04c89 2133;;;###autoload
175d0960
SM
2134(defvar menu-bar-bookmark-map
2135 (let ((map (make-sparse-keymap "Bookmark functions")))
905a9ed3
DN
2136 (define-key map [load]
2137 `(menu-item ,(purecopy "Load a Bookmark File...") bookmark-load
2138 :help ,(purecopy "Load bookmarks from a bookmark file)")))
2139 (define-key map [write]
2140 `(menu-item ,(purecopy "Save Bookmarks As...") bookmark-write
2141 :help ,(purecopy "Write bookmarks to a file (reading the file name with the minibuffer)")))
2142 (define-key map [save]
2143 `(menu-item ,(purecopy "Save Bookmarks") bookmark-save
2144 :help ,(purecopy "Save currently defined bookmarks")))
2145 (define-key map [edit]
2146 `(menu-item ,(purecopy "Edit Bookmark List") bookmark-bmenu-list
2147 :help ,(purecopy "Display a list of existing bookmarks")))
2148 (define-key map [delete]
2149 `(menu-item ,(purecopy "Delete Bookmark...") bookmark-delete
2150 :help ,(purecopy "Delete a bookmark from the bookmark list")))
2151 (define-key map [rename]
2152 `(menu-item ,(purecopy "Rename Bookmark...") bookmark-rename
2153 :help ,(purecopy "Change the name of a bookmark")))
2154 (define-key map [locate]
2155 `(menu-item ,(purecopy "Insert Location...") bookmark-locate
2156 :help ,(purecopy "Insert the name of the file associated with a bookmark")))
2157 (define-key map [insert]
2158 `(menu-item ,(purecopy "Insert Contents...") bookmark-insert
2159 :help ,(purecopy "Insert the text of the file pointed to by a bookmark")))
2160 (define-key map [set]
2161 `(menu-item ,(purecopy "Set Bookmark...") bookmark-set
2162 :help ,(purecopy "Set a bookmark named inside a file.")))
2163 (define-key map [jump]
2164 `(menu-item ,(purecopy "Jump to Bookmark...") bookmark-jump
2165 :help ,(purecopy "Jump to a bookmark (a point in some file)")))
175d0960 2166 map))
09fd6588 2167
7af04c89 2168;;;###autoload
175d0960 2169(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
e3437989 2170
09fd6588
KF
2171;; make bookmarks appear toward the right side of the menu.
2172(if (boundp 'menu-bar-final-items)
dbe99ae9 2173 (if menu-bar-final-items
b861e45e 2174 (push 'bookmark menu-bar-final-items))
09fd6588
KF
2175 (setq menu-bar-final-items '(bookmark)))
2176
e3437989
RS
2177;;;; end bookmark menu stuff ;;;;
2178
2179\f
43f8b275 2180;; Load Hook
e3437989 2181(defvar bookmark-load-hook nil
175d0960 2182 "Hook run at the end of loading bookmark.")
e3437989 2183
43f8b275 2184;; Exit Hook, called from kill-emacs-hook
6192b604 2185(defvar bookmark-exit-hook nil
d32ff76a
JB
2186 "Hook run when Emacs exits.")
2187
2188(define-obsolete-variable-alias 'bookmark-exit-hooks 'bookmark-exit-hook "22.1")
dbe99ae9 2189
6192b604
KF
2190(defun bookmark-exit-hook-internal ()
2191 "Save bookmark state, if necessary, at Emacs exit time.
d32ff76a
JB
2192This also runs `bookmark-exit-hook'."
2193 (run-hooks 'bookmark-exit-hook)
175d0960
SM
2194 (and bookmark-alist
2195 (bookmark-time-to-save-p t)
2196 (bookmark-save)))
6192b604
KF
2197
2198(add-hook 'kill-emacs-hook 'bookmark-exit-hook-internal)
2199
a35809ba
JB
2200(defun bookmark-unload-function ()
2201 "Unload the Bookmark library."
2202 (when bookmark-save-flag (bookmark-save))
2203 ;; continue standard unloading
2204 nil)
2205
6192b604 2206
e3437989 2207(run-hooks 'bookmark-load-hook)
b3bf02fa 2208
b3bf02fa 2209(provide 'bookmark)
dbe99ae9 2210
3da360a7 2211;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
11eb4275 2212;;; bookmark.el ends here