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