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