(region-active-p): Doc fix.
[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,
d7a0267c 4;; 2004, 2005, 2006, 2007 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
e3437989 446
4c0b5ad1
KF
447(defvar bookmark-history nil
448 "The history list for bookmark functions.")
449
450
e3437989
RS
451(defun bookmark-completing-read (prompt &optional default)
452 "Prompting with PROMPT, read a bookmark name in completion.
453PROMPT will get a \": \" stuck on the end no matter what, so you
454probably don't want to include one yourself.
455Optional second arg DEFAULT is a string to return if the user enters
456the empty string."
457 (bookmark-maybe-load-default-file) ; paranoia
175d0960
SM
458 (if (listp last-nonmenu-event)
459 (bookmark-menu-popup-paned-menu t prompt (bookmark-all-names))
460 (let* ((completion-ignore-case bookmark-completion-ignore-case)
461 (default default)
462 (prompt (if default
463 (concat prompt (format " (%s): " default))
464 (concat prompt ": ")))
465 (str
466 (completing-read prompt
467 bookmark-alist
468 nil
469 0
470 nil
471 'bookmark-history)))
472 (if (string-equal "" str) default str))))
e3437989
RS
473
474
4c0b5ad1
KF
475(defmacro bookmark-maybe-historicize-string (string)
476 "Put STRING into the bookmark prompt history, if caller non-interactive.
477We need this because sometimes bookmark functions are invoked from
478menus, so `completing-read' never gets a chance to set `bookmark-history'."
dbe99ae9
SS
479 `(or
480 (interactive-p)
481 (setq bookmark-history (cons ,string bookmark-history))))
4c0b5ad1
KF
482
483
a15269c0 484(defun bookmark-make (name &optional annotation overwrite info-node)
e3437989
RS
485 "Make a bookmark named NAME.
486Optional second arg ANNOTATION gives it an annotation.
487Optional third arg OVERWRITE means replace any existing bookmarks with
a15269c0
KF
488this name.
489Optional fourth arg INFO-NODE means this bookmark is at info node
490INFO-NODE, so record this fact in the bookmark's entry."
e3437989 491 (bookmark-maybe-load-default-file)
88415bfc 492 (let ((stripped-name (copy-sequence name)))
4211e434 493 (or (featurep 'xemacs)
09fd6588
KF
494 ;; XEmacs's `set-text-properties' doesn't work on
495 ;; free-standing strings, apparently.
496 (set-text-properties 0 (length stripped-name) nil stripped-name))
88415bfc 497 (if (and (bookmark-get-bookmark stripped-name) (not overwrite))
3b526bae 498 ;; already existing bookmark under that name and
88415bfc
KH
499 ;; no prefix arg means just overwrite old bookmark
500 (setcdr (bookmark-get-bookmark stripped-name)
a15269c0 501 (list (bookmark-make-cell annotation info-node)))
dbe99ae9 502
88415bfc
KH
503 ;; otherwise just cons it onto the front (either the bookmark
504 ;; doesn't exist already, or there is no prefix arg. In either
505 ;; case, we want the new bookmark consed onto the alist...)
dbe99ae9 506
88415bfc
KH
507 (setq bookmark-alist
508 (cons
dbe99ae9 509 (list stripped-name
a15269c0 510 (bookmark-make-cell annotation info-node))
88415bfc 511 bookmark-alist)))
dbe99ae9 512
88415bfc
KH
513 ;; Added by db
514 (setq bookmark-current-bookmark stripped-name)
515 (setq bookmark-alist-modification-count
516 (1+ bookmark-alist-modification-count))
517 (if (bookmark-time-to-save-p)
518 (bookmark-save))))
e3437989
RS
519
520
a15269c0 521(defun bookmark-make-cell (annotation &optional info-node)
4eadcdf8 522 "Return the record part of a new bookmark, given ANNOTATION.
e3437989 523Must be at the correct position in the buffer in which the bookmark is
a15269c0
KF
524being set. This might change someday.
525Optional second arg INFO-NODE means this bookmark is at info node
526INFO-NODE, so record this fact in the bookmark's entry."
527 (let ((the-record
8a946354
SS
528 `((filename . ,(bookmark-buffer-file-name))
529 (front-context-string
530 . ,(if (>= (- (point-max) (point)) bookmark-search-size)
531 (buffer-substring-no-properties
532 (point)
533 (+ (point) bookmark-search-size))
534 nil))
535 (rear-context-string
536 . ,(if (>= (- (point) (point-min)) bookmark-search-size)
537 (buffer-substring-no-properties
538 (point)
539 (- (point) bookmark-search-size))
540 nil))
541 (position . ,(point)))))
a15269c0
KF
542
543 ;; Now fill in the optional parts:
91169ba7
RS
544
545 ;; Take no chances with text properties
546 (set-text-properties 0 (length annotation) nil annotation)
547 (set-text-properties 0 (length info-node) nil info-node)
548
a15269c0
KF
549 (if annotation
550 (nconc the-record (list (cons 'annotation annotation))))
551 (if info-node
552 (nconc the-record (list (cons 'info-node info-node))))
553
554 ;; Finally, return the completed record.
555 the-record))
dbe99ae9
SS
556
557
e3437989
RS
558\f
559;;; File format stuff
560
561;; The OLD format of the bookmark-alist was:
562;;
563;; ((bookmark-name (filename
564;; string-in-front
565;; string-behind
566;; point))
567;; ...)
568;;
569;; The NEW format of the bookmark-alist is:
570;;
571;; ((bookmark-name ((filename . FILENAME)
572;; (front-context-string . string-in-front)
573;; (rear-context-string . string-behind)
574;; (position . POINT)
575;; (annotation . annotation)
576;; (whatever . VALUE)
577;; ...
578;; ))
579;; ...)
580;;
581;;
582;; I switched to using an internal as well as external alist because I
583;; felt that would be a more flexible framework in which to add
584;; features. It means that the order in which values appear doesn't
585;; matter, and it means that arbitrary values can be added without
586;; risk of interfering with existing ones.
587;;
588;; BOOKMARK-NAME is the string the user gives the bookmark and
dbe99ae9 589;; accesses it by from then on.
e3437989
RS
590;;
591;; FILENAME is the location of the file in which the bookmark is set.
592;;
593;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
594;; context in front of the point at which the bookmark is set.
595;;
dbe99ae9 596;; STRING-BEHIND is the same thing, but after the point.
e3437989
RS
597;;
598;; The context strings exist so that modifications to a file don't
dbe99ae9 599;; necessarily cause a bookmark's position to be invalidated.
e3437989
RS
600;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
601;; case the file has changed since the bookmark was set. It will
602;; attempt to place the user before the changes, if there were any.
a15269c0 603;; ANNOTATION is the annotation for the bookmark; it may not exist
e3437989
RS
604;; (for backward compatibility), be nil (no annotation), or be a
605;; string.
e3437989
RS
606
607
608(defconst bookmark-file-format-version 1
609 "The current version of the format used by bookmark files.
610You should never need to change this.")
611
612
613(defconst bookmark-end-of-version-stamp-marker
614 "-*- End Of Bookmark File Format Version Stamp -*-\n"
615 "This string marks the end of the version stamp in a bookmark file.")
616
617
618(defun bookmark-alist-from-buffer ()
d32ff76a 619 "Return a `bookmark-alist' (in any format) from the current buffer.
e3437989
RS
620The buffer must of course contain bookmark format information.
621Does not care from where in the buffer it is called, and does not
622affect point."
623 (save-excursion
624 (goto-char (point-min))
625 (if (search-forward bookmark-end-of-version-stamp-marker nil t)
626 (read (current-buffer))
627 ;; Else we're dealing with format version 0
628 (if (search-forward "(" nil t)
629 (progn
630 (forward-char -1)
631 (read (current-buffer)))
632 ;; Else no hope of getting information here.
a3ad20c2 633 (error "Not bookmark format")))))
e3437989
RS
634
635
636(defun bookmark-upgrade-version-0-alist (old-list)
4eadcdf8 637 "Upgrade a version 0 alist OLD-LIST to the current version."
e3437989
RS
638 (mapcar
639 (lambda (bookmark)
640 (let* ((name (car bookmark))
641 (record (car (cdr bookmark)))
642 (filename (nth 0 record))
643 (front-str (nth 1 record))
644 (rear-str (nth 2 record))
645 (position (nth 3 record))
646 (ann (nth 4 record)))
647 (list
648 name
8a946354
SS
649 `((filename . ,filename)
650 (front-context-string . ,(or front-str ""))
651 (rear-context-string . ,(or rear-str ""))
652 (position . ,position)
653 (annotation . ,ann)))))
e3437989
RS
654 old-list))
655
656
657(defun bookmark-upgrade-file-format-from-0 ()
658 "Upgrade a bookmark file of format 0 (the original format) to format 1.
d32ff76a 659This expects to be called from `point-min' in a bookmark file."
e3437989
RS
660 (message "Upgrading bookmark format from 0 to %d..."
661 bookmark-file-format-version)
662 (let* ((old-list (bookmark-alist-from-buffer))
663 (new-list (bookmark-upgrade-version-0-alist old-list)))
664 (delete-region (point-min) (point-max))
665 (bookmark-insert-file-format-version-stamp)
666 (pp new-list (current-buffer))
667 (save-buffer))
668 (goto-char (point-min))
60d0378e 669 (message "Upgrading bookmark format from 0 to %d...done"
e3437989
RS
670 bookmark-file-format-version)
671 )
672
673
674(defun bookmark-grok-file-format-version ()
675 "Return an integer which is the file-format version of this bookmark file.
d32ff76a 676This expects to be called from `point-min' in a bookmark file."
e3437989
RS
677 (if (looking-at "^;;;;")
678 (save-excursion
679 (save-match-data
680 (re-search-forward "[0-9]")
681 (forward-char -1)
682 (read (current-buffer))))
683 ;; Else this is format version 0, the original one, which didn't
684 ;; even have version stamps.
685 0))
686
687
688(defun bookmark-maybe-upgrade-file-format ()
689 "Check the file-format version of this bookmark file.
690If the version is not up-to-date, upgrade it automatically.
d32ff76a 691This expects to be called from `point-min' in a bookmark file."
e3437989
RS
692 (let ((version (bookmark-grok-file-format-version)))
693 (cond
694 ((= version bookmark-file-format-version)
695 ) ; home free -- version is current
696 ((= version 0)
697 (bookmark-upgrade-file-format-from-0))
698 (t
a3ad20c2 699 (error "Bookmark file format version strangeness")))))
e3437989
RS
700
701
702(defun bookmark-insert-file-format-version-stamp ()
5e0e5feb 703 "Insert text indicating current version of bookmark file format."
e3437989
RS
704 (insert
705 (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
706 bookmark-file-format-version))
707 (insert ";;; This format is meant to be slightly human-readable;\n"
708 ";;; nevertheless, you probably don't want to edit it.\n"
709 ";;; "
710 bookmark-end-of-version-stamp-marker))
711
712
713;;; end file-format stuff
714
715\f
9a9f1fdd
KF
716;;; Generic helpers.
717
718(defun bookmark-maybe-message (fmt &rest args)
719 "Apply `message' to FMT and ARGS, but only if the display is fast enough."
720 (if (>= baud-rate 9600)
721 (apply 'message fmt args)))
722
723\f
e3437989
RS
724;;; Core code:
725
d22d6453 726;;;###autoload
4eadcdf8
RS
727(defun bookmark-set (&optional name parg)
728 "Set a bookmark named NAME inside a file.
729If name is nil, then the user will be prompted.
9aef3b21
RS
730With prefix arg, will not overwrite a bookmark that has the same name
731as NAME if such a bookmark already exists, but instead will \"push\"
732the new bookmark onto the bookmark alist. Thus the most recently set
733bookmark with name NAME would be the one in effect at any given time,
734but the others are still there, should you decide to delete the most
735recent one.
b3bf02fa
RS
736
737To yank words from the text of the buffer and use them as part of the
9aef3b21 738bookmark name, type C-w while setting a bookmark. Successive C-w's
b3bf02fa
RS
739yank successive words.
740
4c0b5ad1
KF
741Typing C-u inserts the name of the last bookmark used in the buffer
742\(as an aid in using a single bookmark name to track your progress
743through a large file\). If no bookmark was used, then C-u inserts the
744name of the file being visited.
b3bf02fa
RS
745
746Use \\[bookmark-delete] to remove bookmarks \(you give it a name,
747and it removes only the first instance of a bookmark with that name from
748the list of bookmarks.\)"
4eadcdf8 749 (interactive (list nil current-prefix-arg))
e3437989
RS
750 (or
751 (bookmark-buffer-file-name)
a3ad20c2 752 (error "Buffer not visiting a file or directory"))
e3437989
RS
753
754 (bookmark-maybe-load-default-file)
755
b3bf02fa
RS
756 (setq bookmark-current-point (point))
757 (setq bookmark-yank-point (point))
758 (setq bookmark-current-buffer (current-buffer))
e3437989 759
d22d6453 760 (let* ((default (or bookmark-current-bookmark
e3437989 761 (bookmark-buffer-name)))
d22d6453 762 (str
4eadcdf8
RS
763 (or name
764 (read-from-minibuffer
765 (format "Set bookmark (%s): " default)
766 nil
767 (let ((now-map (copy-keymap minibuffer-local-map)))
91169ba7
RS
768 (define-key now-map "\C-w" 'bookmark-yank-word)
769 (define-key now-map "\C-u" 'bookmark-insert-current-bookmark)
4eadcdf8 770 now-map))))
e3437989
RS
771 (annotation nil))
772 (and (string-equal str "") (setq str default))
dbe99ae9 773 ;; Ask for an annotation buffer for this bookmark
e3437989
RS
774 (if bookmark-use-annotations
775 (bookmark-read-annotation parg str)
91169ba7
RS
776 (bookmark-make str annotation parg (bookmark-info-current-node))
777 (setq bookmark-current-bookmark str)
778 (bookmark-bmenu-surreptitiously-rebuild-list)
779 (goto-char bookmark-current-point))))
e3437989
RS
780
781
a15269c0
KF
782(defun bookmark-info-current-node ()
783 "If in Info-mode, return current node name (a string), else nil."
784 (if (eq major-mode 'Info-mode)
785 Info-current-node))
786
787
e3437989
RS
788(defun bookmark-kill-line (&optional newline-too)
789 "Kill from point to end of line.
790If optional arg NEWLINE-TOO is non-nil, delete the newline too.
d32ff76a 791Does not affect the kill ring."
e3437989
RS
792 (let ((eol (save-excursion (end-of-line) (point))))
793 (delete-region (point) eol)
794 (if (and newline-too (looking-at "\n"))
795 (delete-char 1))))
796
797
4c0b5ad1
KF
798;; Defvars to avoid compilation warnings:
799(defvar bookmark-annotation-paragraph nil)
800(defvar bookmark-annotation-name nil)
801(defvar bookmark-annotation-buffer nil)
802(defvar bookmark-annotation-file nil)
803(defvar bookmark-annotation-point nil)
804
805
e3437989 806(defun bookmark-send-annotation ()
5e0e5feb
RS
807 "Use buffer contents as the annotation for a bookmark.
808Exclude lines that begin with `#'.
809Store the annotation text in the bookmark list with
e3437989
RS
810the bookmark (and file, and point) specified in buffer local variables."
811 (interactive)
812 (if (not (eq major-mode 'bookmark-read-annotation-mode))
a3ad20c2 813 (error "Not in bookmark-read-annotation-mode"))
e3437989
RS
814 (goto-char (point-min))
815 (while (< (point) (point-max))
816 (if (looking-at "^#")
817 (bookmark-kill-line t)
818 (forward-line 1)))
91169ba7 819 (let ((annotation (buffer-string))
e3437989
RS
820 (parg bookmark-annotation-paragraph)
821 (bookmark bookmark-annotation-name)
822 (pt bookmark-annotation-point)
823 (buf bookmark-annotation-buffer))
824 ;; for bookmark-make-cell to work, we need to be
825 ;; in the relevant buffer, at the relevant point.
826 ;; Actually, bookmark-make-cell should probably be re-written,
827 ;; to avoid this need. Should I handle the error if a buffer is
828 ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
dbe99ae9 829 (save-excursion
e3437989
RS
830 (pop-to-buffer buf)
831 (goto-char pt)
a15269c0 832 (bookmark-make bookmark annotation parg (bookmark-info-current-node))
e3437989
RS
833 (setq bookmark-current-bookmark bookmark))
834 (bookmark-bmenu-surreptitiously-rebuild-list)
835 (goto-char bookmark-current-point))
836 (kill-buffer (current-buffer)))
837
838
839(defun bookmark-default-annotation-text (bookmark)
840 (concat "# Type the annotation for bookmark '" bookmark "' here.\n"
841 "# All lines which start with a '#' will be deleted.\n"
842 "# Type C-c C-c when done.\n#\n"
843 "# Author: " (user-full-name) " <" (user-login-name) "@"
844 (system-name) ">\n"
845 "# Date: " (current-time-string) "\n"))
846
847
848(defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text
5e0e5feb 849 "Function to return default text to use for a bookmark annotation.
d32ff76a 850It takes one argument, the name of the bookmark, as a string.")
e3437989
RS
851
852(defun bookmark-read-annotation-mode (buf point parg bookmark)
853 "Mode for composing annotations for a bookmark.
d32ff76a 854Wants BUF, POINT, PARG, and BOOKMARK.
e3437989
RS
855When you have finished composing, type \\[bookmark-send-annotation] to send
856the annotation.
857
858\\{bookmark-read-annotation-mode-map}
859"
860 (interactive)
861 (kill-all-local-variables)
862 (make-local-variable 'bookmark-annotation-paragraph)
863 (make-local-variable 'bookmark-annotation-name)
864 (make-local-variable 'bookmark-annotation-buffer)
865 (make-local-variable 'bookmark-annotation-file)
866 (make-local-variable 'bookmark-annotation-point)
867 (setq bookmark-annotation-paragraph parg)
868 (setq bookmark-annotation-name bookmark)
869 (setq bookmark-annotation-buffer buf)
870 (setq bookmark-annotation-file (buffer-file-name buf))
871 (setq bookmark-annotation-point point)
872 (use-local-map bookmark-read-annotation-mode-map)
873 (setq major-mode 'bookmark-read-annotation-mode)
874 (insert (funcall bookmark-read-annotation-text-func bookmark))
f33cee85 875 (run-mode-hooks 'text-mode-hook))
e3437989
RS
876
877
878(defun bookmark-read-annotation (parg bookmark)
5e0e5feb
RS
879 "Pop up a buffer for entering a bookmark annotation.
880Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK."
e3437989
RS
881 (let ((buf (current-buffer))
882 (point (point)))
883 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
884 (bookmark-read-annotation-mode buf point parg bookmark)))
885
886
887(defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map)
888 "Keymap for editing an annotation of a bookmark.")
889
890
891(define-key bookmark-edit-annotation-mode-map "\C-c\C-c"
892 'bookmark-send-edited-annotation)
893
894
895(defun bookmark-edit-annotation-mode (bookmark)
896 "Mode for editing the annotation of bookmark BOOKMARK.
897When you have finished composing, type \\[bookmark-send-annotation].
898
899\\{bookmark-edit-annotation-mode-map}
900"
901 (interactive)
902 (kill-all-local-variables)
903 (make-local-variable 'bookmark-annotation-name)
904 (setq bookmark-annotation-name bookmark)
905 (use-local-map bookmark-edit-annotation-mode-map)
dc5dcc00
JB
906 (setq major-mode 'bookmark-edit-annotation-mode
907 mode-name "Edit Bookmark Annotation")
e3437989
RS
908 (insert (funcall bookmark-read-annotation-text-func bookmark))
909 (let ((annotation (bookmark-get-annotation bookmark)))
91169ba7 910 (if (and annotation (not (string-equal annotation "")))
e3437989 911 (insert annotation)))
f33cee85 912 (run-mode-hooks 'text-mode-hook))
e3437989
RS
913
914
915(defun bookmark-send-edited-annotation ()
dc5dcc00
JB
916 "Use buffer contents as annotation for a bookmark.
917Lines beginning with `#' are ignored."
e3437989
RS
918 (interactive)
919 (if (not (eq major-mode 'bookmark-edit-annotation-mode))
a3ad20c2 920 (error "Not in bookmark-edit-annotation-mode"))
e3437989
RS
921 (goto-char (point-min))
922 (while (< (point) (point-max))
923 (if (looking-at "^#")
924 (bookmark-kill-line t)
925 (forward-line 1)))
91169ba7 926 (let ((annotation (buffer-string))
e3437989
RS
927 (bookmark bookmark-annotation-name))
928 (bookmark-set-annotation bookmark annotation)
929 (bookmark-bmenu-surreptitiously-rebuild-list)
930 (goto-char bookmark-current-point))
931 (kill-buffer (current-buffer)))
932
933
934(defun bookmark-edit-annotation (bookmark)
935 "Pop up a buffer for editing bookmark BOOKMARK's annotation."
175d0960
SM
936 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
937 (bookmark-edit-annotation-mode bookmark))
e3437989 938
b3bf02fa
RS
939
940(defun bookmark-insert-current-bookmark ()
d32ff76a 941 "Insert this buffer's value of `bookmark-current-bookmark'.
5e0e5feb 942Default to file name if it's nil."
b3bf02fa
RS
943 (interactive)
944 (let ((str
945 (save-excursion
946 (set-buffer bookmark-current-buffer)
947 bookmark-current-bookmark)))
4cd51172 948 (if str (insert str) (bookmark-insert-buffer-name))))
b3bf02fa 949
e3437989 950
4cd51172 951(defun bookmark-insert-buffer-name ()
5e0e5feb
RS
952 "Insert the current file name into the bookmark name being set.
953The directory part of the file name is not used."
b3bf02fa 954 (interactive)
e3437989
RS
955 (let ((str
956 (save-excursion
957 (set-buffer bookmark-current-buffer)
4cd51172 958 (bookmark-buffer-name))))
e3437989
RS
959 (insert str)))
960
b3bf02fa 961
4cd51172
RS
962(defun bookmark-buffer-name ()
963 "Return the name of the current buffer's file, non-directory.
964In Info, return the current node."
965 (cond
966 ;; Are we in Info?
967 ((string-equal mode-name "Info") Info-current-node)
968 ;; Or are we a file?
969 (buffer-file-name (file-name-nondirectory buffer-file-name))
970 ;; Or are we a directory?
971 ((and (boundp 'dired-directory) dired-directory)
972 (let* ((dirname (if (stringp dired-directory)
973 dired-directory
974 (car dired-directory)))
975 (idx (1- (length dirname))))
976 ;; Strip the trailing slash.
977 (if (= ?/ (aref dirname idx))
978 (file-name-nondirectory (substring dirname 0 idx))
979 ;; Else return the current-buffer
980 (buffer-name (current-buffer)))))
981 ;; If all else fails, use the buffer's name.
982 (t
983 (buffer-name (current-buffer)))))
984
985
b3bf02fa
RS
986(defun bookmark-yank-word ()
987 (interactive)
988 ;; get the next word from the buffer and append it to the name of
989 ;; the bookmark currently being set.
990 (let ((string (save-excursion
d22d6453
RS
991 (set-buffer bookmark-current-buffer)
992 (goto-char bookmark-yank-point)
88415bfc 993 (buffer-substring-no-properties
d22d6453 994 (point)
91169ba7 995 (progn
d22d6453
RS
996 (forward-word 1)
997 (setq bookmark-yank-point (point)))))))
b3bf02fa
RS
998 (insert string)))
999
b3bf02fa 1000
08dcfdf6
RS
1001(defvar Info-current-file)
1002
b3bf02fa 1003(defun bookmark-buffer-file-name ()
e3437989
RS
1004 "Return the current buffer's file in a way useful for bookmarks.
1005For example, if this is a Info buffer, return the Info file's name."
acf3709f
KF
1006 (cond
1007 ((eq major-mode 'Info-mode)
1008 Info-current-file)
1009 (buffer-file-name
1010 ;; Abbreviate the path, both so it's shorter and so it's more
1011 ;; portable. E.g., the user's home dir might be a different
1012 ;; path on different machines, but "~/" will still reach it.
1013 (abbreviate-file-name buffer-file-name))
1014 ((and (boundp 'dired-directory) dired-directory)
1015 (if (stringp dired-directory)
1016 dired-directory
1017 (car dired-directory)))))
e3437989
RS
1018
1019
e3437989 1020(defun bookmark-maybe-load-default-file ()
d22d6453
RS
1021 (and (not bookmarks-already-loaded)
1022 (null bookmark-alist)
e3437989
RS
1023 (prog2
1024 (and
1025 ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
1026 ;; to be renamed.
1027 (file-exists-p (expand-file-name bookmark-old-default-file))
1028 (not (file-exists-p (expand-file-name bookmark-default-file)))
1029 (rename-file (expand-file-name bookmark-old-default-file)
1030 (expand-file-name bookmark-default-file)))
1031 ;; return t so the `and' will continue...
1032 t)
dbe99ae9 1033
e3437989 1034 (file-readable-p (expand-file-name bookmark-default-file))
91169ba7
RS
1035 (bookmark-load bookmark-default-file t t)
1036 (setq bookmarks-already-loaded t)))
d22d6453 1037
e3437989 1038
d22d6453
RS
1039(defun bookmark-maybe-sort-alist ()
1040 ;;Return the bookmark-alist for display. If the bookmark-sort-flag
1041 ;;is non-nil, then return a sorted copy of the alist.
1042 (if bookmark-sort-flag
1de49d4e
TTN
1043 (sort (copy-alist bookmark-alist)
1044 (function
1045 (lambda (x y) (string-lessp (car x) (car y)))))
1046 bookmark-alist))
d22d6453 1047
e3437989 1048
866a7257
CD
1049(defvar bookmark-after-jump-hook nil
1050 "Hook run after `bookmark-jump' jumps to a bookmark.
1051Useful for example to unhide text in `outline-mode'.")
1052
d22d6453 1053;;;###autoload
4eadcdf8 1054(defun bookmark-jump (bookmark)
dbe99ae9 1055 "Jump to bookmark BOOKMARK (a point in some file).
9aef3b21
RS
1056You may have a problem using this function if the value of variable
1057`bookmark-alist' is nil. If that happens, you need to load in some
1058bookmarks. See help on function `bookmark-load' for more about
d22d6453
RS
1059this.
1060
e3437989 1061If the file pointed to by BOOKMARK no longer exists, you will be asked
d32ff76a 1062if you wish to give the bookmark a new location, and `bookmark-jump'
e3437989
RS
1063will then jump to the new location, as well as recording it in place
1064of the old one in the permanent bookmark record."
1065 (interactive
175d0960
SM
1066 (list (bookmark-completing-read "Jump to bookmark"
1067 bookmark-current-bookmark)))
5d8d3a34
RS
1068 (unless bookmark
1069 (error "No bookmark specified"))
4eadcdf8
RS
1070 (bookmark-maybe-historicize-string bookmark)
1071 (let ((cell (bookmark-jump-noselect bookmark)))
d22d6453
RS
1072 (and cell
1073 (switch-to-buffer (car cell))
e3437989 1074 (goto-char (cdr cell))
f74505ca 1075 (progn (run-hooks 'bookmark-after-jump-hook) t)
2c9ad69f
KF
1076 (if bookmark-automatically-show-annotations
1077 ;; if there is an annotation for this bookmark,
1078 ;; show it in a buffer.
4eadcdf8 1079 (bookmark-show-annotation bookmark)))))
e3437989 1080
d22d6453 1081
241ab2b5
KF
1082;;;###autoload
1083(defun bookmark-jump-other-window (bookmark)
1084 "Jump to BOOKMARK (a point in some file) in another window.
1085See `bookmark-jump'."
1086 (interactive
1087 (let ((bkm (bookmark-completing-read "Jump to bookmark (in another window)"
1088 bookmark-current-bookmark)))
1089 (if (> emacs-major-version 21)
1090 (list bkm) bkm)))
1091 (when bookmark
1092 (bookmark-maybe-historicize-string bookmark)
1093 (let ((cell (bookmark-jump-noselect bookmark)))
1094 (and cell
1095 (switch-to-buffer-other-window (car cell))
1096 (goto-char (cdr cell))
1097 (if bookmark-automatically-show-annotations
1098 ;; if there is an annotation for this bookmark,
1099 ;; show it in a buffer.
1100 (bookmark-show-annotation bookmark))))))
1101
1102
8d56596c 1103(defun bookmark-file-or-variation-thereof (file)
76bc6ee3
KF
1104 "Return FILE (a string) if it exists, or return a reasonable
1105variation of FILE if that exists. Reasonable variations are checked
1106by appending suffixes defined in `Info-suffix-list'. If cannot find FILE
1107nor a reasonable variation thereof, then still return FILE if it can
1108be retrieved from a VC backend, else return nil."
dd33e6e9
KF
1109 (if (file-exists-p file)
1110 file
76bc6ee3
KF
1111 (or
1112 (progn (require 'info) ; ensure Info-suffix-list is bound
1113 (catch 'found
1114 (mapc (lambda (elt)
1115 (let ((suffixed-file (concat file (car elt))))
1116 (if (file-exists-p suffixed-file)
1117 (throw 'found suffixed-file))))
1118 Info-suffix-list)
1119 nil))
1120 ;; Last possibility: try VC
1121 (if (vc-backend file) file))))
1122
8d56596c 1123
d22d6453
RS
1124(defun bookmark-jump-noselect (str)
1125 ;; a leetle helper for bookmark-jump :-)
1126 ;; returns (BUFFER . POINT)
e3437989
RS
1127 (bookmark-maybe-load-default-file)
1128 (let* ((file (expand-file-name (bookmark-get-filename str)))
1129 (forward-str (bookmark-get-front-context-string str))
1130 (behind-str (bookmark-get-rear-context-string str))
1131 (place (bookmark-get-position str))
1132 (info-node (bookmark-get-info-node str))
1133 (orig-file file)
1134 )
8d56596c 1135 (if (setq file (bookmark-file-or-variation-thereof file))
e3437989 1136 (save-excursion
e197b151
RS
1137 (save-window-excursion
1138 (if info-node
1139 ;; Info nodes must be visited with care.
1140 (progn
1141 (require 'info)
08dcfdf6
RS
1142 (with-no-warnings
1143 (Info-find-node file info-node)))
e197b151
RS
1144 ;; Else no Info. Can do an ordinary find-file:
1145 (set-buffer (find-file-noselect file))
1146 (goto-char place))
1147
1148 ;; Go searching forward first. Then, if forward-str exists and
1149 ;; was found in the file, we can search backward for behind-str.
1150 ;; Rationale is that if text was inserted between the two in the
1151 ;; file, it's better to be put before it so you can read it,
1152 ;; rather than after and remain perhaps unaware of the changes.
1153 (if forward-str
1154 (if (search-forward forward-str (point-max) t)
1155 (goto-char (match-beginning 0))))
1156 (if behind-str
1157 (if (search-backward behind-str (point-min) t)
1158 (goto-char (match-end 0))))
1159 ;; added by db
1160 (setq bookmark-current-bookmark str)
1161 (cons (current-buffer) (point))))
1162
91169ba7
RS
1163 ;; Else unable to find the marked file, so ask if user wants to
1164 ;; relocate the bookmark, else remind them to consider deletion.
1165 (ding)
1166 (if (y-or-n-p (concat (file-name-nondirectory orig-file)
1167 " nonexistent. Relocate \""
1168 str
1169 "\"? "))
1170 (progn
1171 (bookmark-relocate str)
1172 ;; gasp! It's a recursive function call in Emacs Lisp!
1173 (bookmark-jump-noselect str))
dbe99ae9 1174 (message
91169ba7
RS
1175 "Bookmark not relocated; consider removing it \(%s\)." str)
1176 nil))))
e3437989 1177
d22d6453
RS
1178
1179;;;###autoload
4eadcdf8 1180(defun bookmark-relocate (bookmark)
5e0e5feb
RS
1181 "Relocate BOOKMARK to another file (reading file name with minibuffer).
1182This makes an already existing bookmark point to that file, instead of
1183the one it used to point at. Useful when a file has been renamed
1184after a bookmark was set in it."
175d0960 1185 (interactive (list (bookmark-completing-read "Bookmark to relocate")))
4eadcdf8 1186 (bookmark-maybe-historicize-string bookmark)
e3437989 1187 (bookmark-maybe-load-default-file)
4eadcdf8 1188 (let* ((bmrk-filename (bookmark-get-filename bookmark))
d22d6453 1189 (newloc (expand-file-name
e3437989 1190 (read-file-name
4eadcdf8 1191 (format "Relocate %s to: " bookmark)
e3437989 1192 (file-name-directory bmrk-filename)))))
91169ba7
RS
1193 (bookmark-set-filename bookmark newloc)
1194 (bookmark-bmenu-surreptitiously-rebuild-list)))
e3437989 1195
d22d6453
RS
1196
1197;;;###autoload
4eadcdf8 1198(defun bookmark-insert-location (bookmark &optional no-history)
4c0b5ad1
KF
1199 "Insert the name of the file associated with BOOKMARK.
1200Optional second arg NO-HISTORY means don't record this in the
1201minibuffer history list `bookmark-history'."
175d0960 1202 (interactive (list (bookmark-completing-read "Insert bookmark location")))
4eadcdf8 1203 (or no-history (bookmark-maybe-historicize-string bookmark))
7e510a5e
RS
1204 (let ((start (point)))
1205 (prog1
1206 (insert (bookmark-location bookmark)) ; *Return this line*
59cfe8b9 1207 (if (and (display-color-p) (display-mouse-p))
8b1b6461
RF
1208 (add-text-properties
1209 start
1210 (save-excursion (re-search-backward
1211 "[^ \t]")
2fbb6576 1212 (1+ (point)))
8b1b6461
RF
1213 '(mouse-face highlight
1214 follow-link t
1215 help-echo "mouse-2: go to this bookmark in other window"))))))
e3437989 1216
fbd98d61 1217;;;###autoload
a15269c0 1218(defalias 'bookmark-locate 'bookmark-insert-location)
e3437989 1219
4eadcdf8 1220(defun bookmark-location (bookmark)
e3437989
RS
1221 "Return the name of the file associated with BOOKMARK."
1222 (bookmark-maybe-load-default-file)
4eadcdf8 1223 (bookmark-get-filename bookmark))
e3437989 1224
d22d6453
RS
1225
1226;;;###autoload
9aef3b21 1227(defun bookmark-rename (old &optional new)
5e0e5feb
RS
1228 "Change the name of OLD bookmark to NEW name.
1229If called from keyboard, prompt for OLD and NEW. If called from
1230menubar, select OLD from a menu and prompt for NEW.
4eadcdf8 1231
5e0e5feb 1232If called from Lisp, prompt for NEW if only OLD was passed as an
4eadcdf8
RS
1233argument. If called with two strings, then no prompting is done. You
1234must pass at least OLD when calling from Lisp.
9aef3b21
RS
1235
1236While you are entering the new name, consecutive C-w's insert
3b526bae 1237consecutive words from the text of the buffer into the new bookmark
4c0b5ad1 1238name."
175d0960 1239 (interactive (list (bookmark-completing-read "Old bookmark name")))
4c0b5ad1 1240 (bookmark-maybe-historicize-string old)
e3437989 1241 (bookmark-maybe-load-default-file)
91169ba7
RS
1242
1243 (setq bookmark-current-point (point))
1244 (setq bookmark-yank-point (point))
1245 (setq bookmark-current-buffer (current-buffer))
1246 (let ((newname
1247 (or new ; use second arg, if non-nil
1248 (read-from-minibuffer
1249 "New name: "
1250 nil
1251 (let ((now-map (copy-keymap minibuffer-local-map)))
1252 (define-key now-map "\C-w" 'bookmark-yank-word)
1253 now-map)
1254 nil
1255 'bookmark-history))))
1256 (bookmark-set-name old newname)
1257 (setq bookmark-current-bookmark newname)
1258 (bookmark-bmenu-surreptitiously-rebuild-list)
1259 (setq bookmark-alist-modification-count
1260 (1+ bookmark-alist-modification-count))
1261 (if (bookmark-time-to-save-p)
1262 (bookmark-save))))
b3bf02fa 1263
e3437989 1264
d22d6453 1265;;;###autoload
4eadcdf8 1266(defun bookmark-insert (bookmark)
dbe99ae9 1267 "Insert the text of the file pointed to by bookmark BOOKMARK.
9aef3b21
RS
1268You may have a problem using this function if the value of variable
1269`bookmark-alist' is nil. If that happens, you need to load in some
1270bookmarks. See help on function `bookmark-load' for more about
8027e2ad 1271this."
175d0960 1272 (interactive (list (bookmark-completing-read "Insert bookmark contents")))
4eadcdf8 1273 (bookmark-maybe-historicize-string bookmark)
e3437989 1274 (bookmark-maybe-load-default-file)
d22d6453
RS
1275 (let ((orig-point (point))
1276 (str-to-insert
1277 (save-excursion
4eadcdf8 1278 (set-buffer (car (bookmark-jump-noselect bookmark)))
91169ba7 1279 (buffer-string))))
d22d6453
RS
1280 (insert str-to-insert)
1281 (push-mark)
1282 (goto-char orig-point)))
1283
e3437989 1284
d22d6453 1285;;;###autoload
e3437989 1286(defun bookmark-delete (bookmark &optional batch)
dbe99ae9 1287 "Delete BOOKMARK from the bookmark list.
9aef3b21
RS
1288Removes only the first instance of a bookmark with that name. If
1289there are one or more other bookmarks with the same name, they will
1290not be deleted. Defaults to the \"current\" bookmark \(that is, the
e3437989
RS
1291one most recently used in this file, if any\).
1292Optional second arg BATCH means don't update the bookmark list buffer,
1293probably because we were called from there."
1294 (interactive
175d0960
SM
1295 (list (bookmark-completing-read "Delete bookmark"
1296 bookmark-current-bookmark)))
4c0b5ad1 1297 (bookmark-maybe-historicize-string bookmark)
e3437989
RS
1298 (bookmark-maybe-load-default-file)
1299 (let ((will-go (bookmark-get-bookmark bookmark)))
11eb4275
RS
1300 (setq bookmark-alist (delq will-go bookmark-alist))
1301 ;; Added by db, nil bookmark-current-bookmark if the last
3b526bae 1302 ;; occurrence has been deleted
e3437989 1303 (or (bookmark-get-bookmark bookmark-current-bookmark)
11eb4275 1304 (setq bookmark-current-bookmark nil)))
e3437989
RS
1305 ;; Don't rebuild the list
1306 (if batch
1307 nil
1308 (bookmark-bmenu-surreptitiously-rebuild-list)
1309 (setq bookmark-alist-modification-count
1310 (1+ bookmark-alist-modification-count))
1311 (if (bookmark-time-to-save-p)
1312 (bookmark-save))))
1313
b3bf02fa
RS
1314
1315(defun bookmark-time-to-save-p (&optional last-time)
1316 ;; By Gregory M. Saunders <saunders@cis.ohio-state.edu>
1317 ;; finds out whether it's time to save bookmarks to a file, by
1318 ;; examining the value of variable bookmark-save-flag, and maybe
1319 ;; bookmark-alist-modification-count. Returns t if they should be
1320 ;; saved, nil otherwise. if last-time is non-nil, then this is
1321 ;; being called when emacs is killed.
dbe99ae9 1322 (cond (last-time
b3bf02fa
RS
1323 (and (> bookmark-alist-modification-count 0)
1324 bookmark-save-flag))
1325 ((numberp bookmark-save-flag)
1326 (>= bookmark-alist-modification-count bookmark-save-flag))
1327 (t
1328 nil)))
1329
e3437989 1330
d22d6453 1331;;;###autoload
b3bf02fa 1332(defun bookmark-write ()
5e0e5feb
RS
1333 "Write bookmarks to a file (reading the file name with the minibuffer).
1334Don't use this in Lisp programs; use `bookmark-save' instead."
b3bf02fa 1335 (interactive)
e3437989 1336 (bookmark-maybe-load-default-file)
b3bf02fa
RS
1337 (bookmark-save t))
1338
e3437989 1339
d22d6453 1340;;;###autoload
dbe99ae9 1341(defun bookmark-save (&optional parg file)
9aef3b21
RS
1342 "Save currently defined bookmarks.
1343Saves by default in the file defined by the variable
4eadcdf8
RS
1344`bookmark-default-file'. With a prefix arg, save it in file FILE
1345\(second argument\).
b3bf02fa 1346
d32ff76a
JB
1347If you are calling this from Lisp, the two arguments are PARG and
1348FILE, and if you just want it to write to the default file, then
b3bf02fa
RS
1349pass no arguments. Or pass in nil and FILE, and it will save in FILE
1350instead. If you pass in one argument, and it is non-nil, then the
1351user will be interactively queried for a file to save in.
1352
11eb4275 1353When you want to load in the bookmarks from a file, use
9aef3b21 1354\`bookmark-load\', \\[bookmark-load]. That function will prompt you
11eb4275 1355for a file, defaulting to the file defined by variable
e3437989 1356`bookmark-default-file'."
b3bf02fa 1357 (interactive "P")
e3437989 1358 (bookmark-maybe-load-default-file)
b3bf02fa
RS
1359 (cond
1360 ((and (null parg) (null file))
1361 ;;whether interactive or not, write to default file
e3437989 1362 (bookmark-write-file bookmark-default-file))
b3bf02fa
RS
1363 ((and (null parg) file)
1364 ;;whether interactive or not, write to given file
1365 (bookmark-write-file file))
1366 ((and parg (not file))
1367 ;;have been called interactively w/ prefix arg
1368 (let ((file (read-file-name "File to save bookmarks in: ")))
1369 (bookmark-write-file file)))
1370 (t ; someone called us with prefix-arg *and* a file, so just write to file
1371 (bookmark-write-file file)))
1372 ;; signal that we have synced the bookmark file by setting this to
1373 ;; 0. If there was an error at any point before, it will not get
1374 ;; set, which is what we want.
1375 (setq bookmark-alist-modification-count 0))
1376
e3437989
RS
1377
1378\f
b3bf02fa
RS
1379(defun bookmark-write-file (file)
1380 (save-excursion
d22d6453 1381 (save-window-excursion
9a9f1fdd 1382 (bookmark-maybe-message "Saving bookmarks to file %s..." file)
a506054a 1383 (set-buffer (get-buffer-create " *Bookmarks*"))
d22d6453 1384 (goto-char (point-min))
a506054a 1385 (delete-region (point-min) (point-max))
8a946354 1386 (let ((print-length nil)
1672462f 1387 (print-level nil))
1672462f
GM
1388 (bookmark-insert-file-format-version-stamp)
1389 (pp bookmark-alist (current-buffer))
1390 (let ((version-control
1391 (cond
1392 ((null bookmark-version-control) nil)
1393 ((eq 'never bookmark-version-control) 'never)
1394 ((eq 'nospecial bookmark-version-control) version-control)
1395 (t
1396 t))))
9552bee8 1397 (condition-case nil
a506054a 1398 (write-region (point-min) (point-max) file)
9552bee8 1399 (file-error (message "Can't write %s" file)))
1672462f 1400 (kill-buffer (current-buffer))
9a9f1fdd
KF
1401 (bookmark-maybe-message
1402 "Saving bookmarks to file %s...done" file))))))
e3437989 1403
d22d6453 1404
91169ba7
RS
1405(defun bookmark-import-new-list (new-list)
1406 ;; Walk over the new list, adding each individual bookmark
1407 ;; carefully. "Carefully" means checking against the existing
1408 ;; bookmark-alist and renaming the new bookmarks with <N> extensions
1409 ;; as necessary.
1410 (let ((lst new-list)
1411 (names (bookmark-all-names)))
1412 (while lst
1413 (let* ((full-record (car lst)))
1414 (bookmark-maybe-rename full-record names)
1415 (setq bookmark-alist (nconc bookmark-alist (list full-record)))
1416 (setq names (cons (bookmark-name-from-full-record full-record) names))
1417 (setq lst (cdr lst))))))
1418
1419
1420(defun bookmark-maybe-rename (full-record names)
1421 ;; just a helper for bookmark-import-new-list; it is only for
1422 ;; readability that this is not inlined.
1423 ;;
1424 ;; Once this has found a free name, it sets full-record to that
1425 ;; name.
1426 (let ((found-name (bookmark-name-from-full-record full-record)))
1427 (if (member found-name names)
1428 ;; We've got a conflict, so generate a new name
1429 (let ((count 2)
1430 (new-name found-name))
1431 (while (member new-name names)
1432 (setq new-name (concat found-name (format "<%d>" count)))
1433 (setq count (1+ count)))
1434 (bookmark-set-name full-record new-name)))))
1435
1436
d22d6453 1437;;;###autoload
91169ba7 1438(defun bookmark-load (file &optional overwrite no-msg)
9aef3b21
RS
1439 "Load bookmarks from FILE (which must be in bookmark format).
1440Appends loaded bookmarks to the front of the list of bookmarks. If
91169ba7 1441optional second argument OVERWRITE is non-nil, existing bookmarks are
9aef3b21
RS
1442destroyed. Optional third arg NO-MSG means don't display any messages
1443while loading.
b3bf02fa
RS
1444
1445If you load a file that doesn't contain a proper bookmark alist, you
9aef3b21 1446will corrupt Emacs's bookmark list. Generally, you should only load
b3bf02fa 1447in files that were created with the bookmark functions in the first
e3437989 1448place. Your own personal bookmark file, `~/.emacs.bmk', is
8027e2ad 1449maintained automatically by Emacs; you shouldn't need to load it
91169ba7
RS
1450explicitly.
1451
1452If you load a file containing bookmarks with the same names as
1453bookmarks already present in your Emacs, the new bookmarks will get
1454unique numeric suffixes \"<2>\", \"<3>\", ... following the same
1455method buffers use to resolve name collisions."
b3bf02fa 1456 (interactive
e3437989
RS
1457 (list (read-file-name
1458 (format "Load bookmarks from: (%s) "
dbe99ae9 1459 bookmark-default-file)
e3437989
RS
1460 ;;Default might not be used often,
1461 ;;but there's no better default, and
1462 ;;I guess it's better than none at all.
1463 "~/" bookmark-default-file 'confirm)))
b3bf02fa
RS
1464 (setq file (expand-file-name file))
1465 (if (file-readable-p file)
1466 (save-excursion
d22d6453 1467 (save-window-excursion
9a9f1fdd
KF
1468 (if (null no-msg)
1469 (bookmark-maybe-message "Loading bookmarks from %s..." file))
186a7127 1470 (set-buffer (let ((enable-local-variables nil))
d23e2c3f 1471 (find-file-noselect file)))
d22d6453 1472 (goto-char (point-min))
e3437989
RS
1473 (bookmark-maybe-upgrade-file-format)
1474 (let ((blist (bookmark-alist-from-buffer)))
d22d6453
RS
1475 (if (listp blist)
1476 (progn
91169ba7
RS
1477 (if overwrite
1478 (progn
1479 (setq bookmark-alist blist)
1480 (setq bookmark-alist-modification-count 0))
1481 ;; else
1482 (bookmark-import-new-list blist)
1483 (setq bookmark-alist-modification-count
1484 (1+ bookmark-alist-modification-count)))
1485 (if (string-equal
1486 (expand-file-name bookmark-default-file)
1487 file)
1488 (setq bookmarks-already-loaded t))
dbe99ae9 1489 (bookmark-bmenu-surreptitiously-rebuild-list))
a3ad20c2 1490 (error "Invalid bookmark list in %s" file)))
d22d6453 1491 (kill-buffer (current-buffer)))
9a9f1fdd
KF
1492 (if (null no-msg)
1493 (bookmark-maybe-message "Loading bookmarks from %s...done" file)))
a3ad20c2 1494 (error "Cannot read bookmark file %s" file)))
b3bf02fa 1495
d22d6453 1496
e3437989
RS
1497\f
1498;;; Code supporting the dired-like bookmark menu. Prefix is
1499;;; "bookmark-bmenu" for "buffer-menu":
1500
1501
1502(defvar bookmark-bmenu-bookmark-column nil)
d22d6453 1503
d22d6453 1504
e3437989
RS
1505(defvar bookmark-bmenu-hidden-bookmarks ())
1506
1507
e3437989 1508(defvar bookmark-bmenu-mode-map nil)
d22d6453 1509
d22d6453 1510
e3437989 1511(if bookmark-bmenu-mode-map
d22d6453 1512 nil
e3437989
RS
1513 (setq bookmark-bmenu-mode-map (make-keymap))
1514 (suppress-keymap bookmark-bmenu-mode-map t)
31cd9611 1515 (define-key bookmark-bmenu-mode-map "q" 'quit-window)
e3437989
RS
1516 (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
1517 (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
1518 (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
1519 (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window)
1520 (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
fbd98d61 1521 (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
e3437989 1522 (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
74002bdf 1523 (define-key bookmark-bmenu-mode-map "\C-m" 'bookmark-bmenu-this-window)
e3437989 1524 (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
fbd98d61
KF
1525 (define-key bookmark-bmenu-mode-map "\C-o"
1526 'bookmark-bmenu-switch-other-window)
e3437989
RS
1527 (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save)
1528 (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete)
1529 (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards)
1530 (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions)
e3437989
RS
1531 (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete)
1532 (define-key bookmark-bmenu-mode-map " " 'next-line)
1533 (define-key bookmark-bmenu-mode-map "n" 'next-line)
1534 (define-key bookmark-bmenu-mode-map "p" 'previous-line)
1535 (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark)
1536 (define-key bookmark-bmenu-mode-map "?" 'describe-mode)
1537 (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark)
1538 (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark)
dbe99ae9 1539 (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
e3437989 1540 (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
037b0a87 1541 (define-key bookmark-bmenu-mode-map "R" 'bookmark-bmenu-relocate)
e3437989
RS
1542 (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
1543 (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
1544 (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
7e510a5e
RS
1545 (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)
1546 (define-key bookmark-bmenu-mode-map [mouse-2]
1547 'bookmark-bmenu-other-window-with-mouse))
e3437989 1548
dbe99ae9 1549
e3437989
RS
1550
1551;; Bookmark Buffer Menu mode is suitable only for specially formatted
1552;; data.
1553(put 'bookmark-bmenu-mode 'mode-class 'special)
1554
1555
1556;; todo: need to display whether or not bookmark exists as a buffer in
dbe99ae9 1557;; flag column.
d22d6453
RS
1558
1559;; Format:
e3437989
RS
1560;; FLAGS BOOKMARK [ LOCATION ]
1561
1562
1563(defun bookmark-bmenu-surreptitiously-rebuild-list ()
1564 "Rebuild the Bookmark List if it exists.
1565Don't affect the buffer ring order."
1566 (if (get-buffer "*Bookmark List*")
1567 (save-excursion
dbe99ae9 1568 (save-window-excursion
e3437989 1569 (bookmark-bmenu-list)))))
d22d6453 1570
d22d6453
RS
1571
1572;;;###autoload
e3437989 1573(defun bookmark-bmenu-list ()
d22d6453
RS
1574 "Display a list of existing bookmarks.
1575The list is displayed in a buffer named `*Bookmark List*'.
e3437989
RS
1576The leftmost column displays a D if the bookmark is flagged for
1577deletion, or > if it is flagged for displaying."
d22d6453 1578 (interactive)
e3437989
RS
1579 (bookmark-maybe-load-default-file)
1580 (if (interactive-p)
1581 (switch-to-buffer (get-buffer-create "*Bookmark List*"))
1582 (set-buffer (get-buffer-create "*Bookmark List*")))
175d0960
SM
1583 (let ((inhibit-read-only t))
1584 (erase-buffer)
d22d6453 1585 (insert "% Bookmark\n- --------\n")
37789292
RF
1586 (add-text-properties (point-min) (point)
1587 '(font-lock-face bookmark-menu-heading))
76865665 1588 (mapc
e3437989 1589 (lambda (full-record)
3b526bae 1590 ;; if a bookmark has an annotation, prepend a "*"
e3437989
RS
1591 ;; in the list of bookmarks.
1592 (let ((annotation (bookmark-get-annotation
1593 (bookmark-name-from-full-record full-record))))
91169ba7 1594 (if (and annotation (not (string-equal annotation "")))
e3437989
RS
1595 (insert " *")
1596 (insert " "))
7e510a5e
RS
1597 (let ((start (point)))
1598 (insert (bookmark-name-from-full-record full-record))
59cfe8b9 1599 (if (and (display-color-p) (display-mouse-p))
8b1b6461
RF
1600 (add-text-properties
1601 start
1602 (save-excursion (re-search-backward
1603 "[^ \t]")
1604 (1+ (point)))
1605 '(mouse-face highlight
1606 follow-link t
1607 help-echo "mouse-2: go to this bookmark in other window")))
7e510a5e
RS
1608 (insert "\n")
1609 )))
1de49d4e 1610 (bookmark-maybe-sort-alist)))
d22d6453
RS
1611 (goto-char (point-min))
1612 (forward-line 2)
e3437989
RS
1613 (bookmark-bmenu-mode)
1614 (if bookmark-bmenu-toggle-filenames
1615 (bookmark-bmenu-toggle-filenames t)))
1616
1617;;;###autoload
1618(defalias 'list-bookmarks 'bookmark-bmenu-list)
1619;;;###autoload
1620(defalias 'edit-bookmarks 'bookmark-bmenu-list)
d22d6453 1621
e3437989
RS
1622
1623
1624(defun bookmark-bmenu-mode ()
d22d6453
RS
1625 "Major mode for editing a list of bookmarks.
1626Each line describes one of the bookmarks in Emacs.
1627Letters do not insert themselves; instead, they are commands.
3b526bae 1628Bookmark names preceded by a \"*\" have annotations.
e3437989
RS
1629\\<bookmark-bmenu-mode-map>
1630\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
1631\\[bookmark-bmenu-select] -- select bookmark of line point is on.
1632 Also show bookmarks marked using m in other windows.
1633\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
1634\\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
1635\\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window.
1636\\[bookmark-bmenu-2-window] -- select this bookmark in one window,
d22d6453 1637 together with bookmark selected before this one in another window.
e3437989
RS
1638\\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer.
1639\\[bookmark-bmenu-other-window] -- select this bookmark in another window,
d22d6453 1640 so the bookmark menu bookmark remains visible in its window.
e3437989 1641\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
dbe99ae9 1642\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
037b0a87 1643\\[bookmark-bmenu-relocate] -- relocate this bookmark's file \(prompts for new file\).
e3437989 1644\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
dbe99ae9 1645\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
60d0378e 1646\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
e3437989 1647\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
d22d6453 1648 With a prefix arg, prompts for a file to save in.
e3437989
RS
1649\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
1650\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
d22d6453 1651 With prefix argument, also move up one line.
e3437989
RS
1652\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
1653\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
1654 in another buffer.
1655\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
1656\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
d22d6453 1657 (kill-all-local-variables)
e3437989 1658 (use-local-map bookmark-bmenu-mode-map)
d22d6453
RS
1659 (setq truncate-lines t)
1660 (setq buffer-read-only t)
e3437989 1661 (setq major-mode 'bookmark-bmenu-mode)
d22d6453 1662 (setq mode-name "Bookmark Menu")
f33cee85 1663 (run-mode-hooks 'bookmark-bmenu-mode-hook))
d22d6453 1664
e3437989 1665
4eadcdf8 1666(defun bookmark-bmenu-toggle-filenames (&optional show)
d22d6453
RS
1667 "Toggle whether filenames are shown in the bookmark list.
1668Optional argument SHOW means show them unconditionally."
1669 (interactive)
1670 (cond
4eadcdf8 1671 (show
e3437989
RS
1672 (setq bookmark-bmenu-toggle-filenames nil)
1673 (bookmark-bmenu-show-filenames)
1674 (setq bookmark-bmenu-toggle-filenames t))
1675 (bookmark-bmenu-toggle-filenames
1676 (bookmark-bmenu-hide-filenames)
1677 (setq bookmark-bmenu-toggle-filenames nil))
d22d6453 1678 (t
e3437989
RS
1679 (bookmark-bmenu-show-filenames)
1680 (setq bookmark-bmenu-toggle-filenames t))))
1681
d22d6453 1682
e3437989
RS
1683(defun bookmark-bmenu-show-filenames (&optional force)
1684 (if (and (not force) bookmark-bmenu-toggle-filenames)
d22d6453
RS
1685 nil ;already shown, so do nothing
1686 (save-excursion
1687 (save-window-excursion
1688 (goto-char (point-min))
1689 (forward-line 2)
e3437989 1690 (setq bookmark-bmenu-hidden-bookmarks ())
175d0960 1691 (let ((inhibit-read-only t))
d22d6453 1692 (while (< (point) (point-max))
e3437989
RS
1693 (let ((bmrk (bookmark-bmenu-bookmark)))
1694 (setq bookmark-bmenu-hidden-bookmarks
1695 (cons bmrk bookmark-bmenu-hidden-bookmarks))
7e510a5e
RS
1696 (let ((start (save-excursion (end-of-line) (point))))
1697 (move-to-column bookmark-bmenu-file-column t)
1698 ;; Strip off `mouse-face' from the white spaces region.
59cfe8b9 1699 (if (and (display-color-p) (display-mouse-p))
7e510a5e 1700 (remove-text-properties start (point)
2fbb6576 1701 '(mouse-face nil help-echo nil))))
7e510a5e 1702 (delete-region (point) (progn (end-of-line) (point)))
d22d6453 1703 (insert " ")
4c0b5ad1
KF
1704 ;; Pass the NO-HISTORY arg:
1705 (bookmark-insert-location bmrk t)
d22d6453
RS
1706 (forward-line 1))))))))
1707
e3437989
RS
1708
1709(defun bookmark-bmenu-hide-filenames (&optional force)
1710 (if (and (not force) bookmark-bmenu-toggle-filenames)
d22d6453
RS
1711 ;; nothing to hide if above is nil
1712 (save-excursion
1713 (save-window-excursion
1714 (goto-char (point-min))
1715 (forward-line 2)
e3437989
RS
1716 (setq bookmark-bmenu-hidden-bookmarks
1717 (nreverse bookmark-bmenu-hidden-bookmarks))
d22d6453
RS
1718 (save-excursion
1719 (goto-char (point-min))
1720 (search-forward "Bookmark")
1721 (backward-word 1)
e3437989 1722 (setq bookmark-bmenu-bookmark-column (current-column)))
d22d6453 1723 (save-excursion
175d0960 1724 (let ((inhibit-read-only t))
e3437989
RS
1725 (while bookmark-bmenu-hidden-bookmarks
1726 (move-to-column bookmark-bmenu-bookmark-column t)
1727 (bookmark-kill-line)
7e510a5e
RS
1728 (let ((start (point)))
1729 (insert (car bookmark-bmenu-hidden-bookmarks))
59cfe8b9 1730 (if (and (display-color-p) (display-mouse-p))
8b1b6461
RF
1731 (add-text-properties
1732 start
1733 (save-excursion (re-search-backward
1734 "[^ \t]")
1735 (1+ (point)))
1736 '(mouse-face highlight
1737 follow-link t
1738 help-echo
1739 "mouse-2: go to this bookmark in other window"))))
e3437989
RS
1740 (setq bookmark-bmenu-hidden-bookmarks
1741 (cdr bookmark-bmenu-hidden-bookmarks))
d22d6453
RS
1742 (forward-line 1))))))))
1743
e3437989 1744
e3437989 1745(defun bookmark-bmenu-check-position ()
91169ba7
RS
1746 ;; Returns non-nil if on a line with a bookmark.
1747 ;; (The actual value returned is bookmark-alist).
1748 ;; Else reposition and try again, else return nil.
d22d6453
RS
1749 (cond ((< (count-lines (point-min) (point)) 2)
1750 (goto-char (point-min))
1751 (forward-line 2)
91169ba7 1752 bookmark-alist)
d22d6453
RS
1753 ((and (bolp) (eobp))
1754 (beginning-of-line 0)
91169ba7 1755 bookmark-alist)
d22d6453 1756 (t
91169ba7 1757 bookmark-alist)))
d22d6453 1758
e3437989
RS
1759
1760(defun bookmark-bmenu-bookmark ()
d22d6453 1761 ;; return a string which is bookmark of this line.
e3437989 1762 (if (bookmark-bmenu-check-position)
d22d6453
RS
1763 (save-excursion
1764 (save-window-excursion
1765 (goto-char (point-min))
1766 (search-forward "Bookmark")
1767 (backward-word 1)
e3437989
RS
1768 (setq bookmark-bmenu-bookmark-column (current-column)))))
1769 (if bookmark-bmenu-toggle-filenames
1770 (bookmark-bmenu-hide-filenames))
d22d6453
RS
1771 (save-excursion
1772 (save-window-excursion
1773 (beginning-of-line)
e3437989 1774 (forward-char bookmark-bmenu-bookmark-column)
d22d6453 1775 (prog1
dbe99ae9
SS
1776 (buffer-substring-no-properties (point)
1777 (progn
d22d6453
RS
1778 (end-of-line)
1779 (point)))
1780 ;; well, this is certainly crystal-clear:
e3437989
RS
1781 (if bookmark-bmenu-toggle-filenames
1782 (bookmark-bmenu-toggle-filenames t))))))
d22d6453 1783
e3437989
RS
1784
1785(defun bookmark-show-annotation (bookmark)
1786 "Display the annotation for bookmark named BOOKMARK in a buffer,
1787if an annotation exists."
1788 (let ((annotation (bookmark-get-annotation bookmark)))
91169ba7
RS
1789 (if (and annotation (not (string-equal annotation "")))
1790 (save-excursion
1791 (let ((old-buf (current-buffer)))
1792 (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1793 (delete-region (point-min) (point-max))
1794 ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
1795 (insert annotation)
1796 (goto-char (point-min))
1797 (pop-to-buffer old-buf))))))
e3437989
RS
1798
1799
1800(defun bookmark-show-all-annotations ()
1801 "Display the annotations for all bookmarks in a buffer."
1802 (let ((old-buf (current-buffer)))
1803 (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1804 (delete-region (point-min) (point-max))
76865665 1805 (mapc
e3437989
RS
1806 (lambda (full-record)
1807 (let* ((name (bookmark-name-from-full-record full-record))
1808 (ann (bookmark-get-annotation name)))
1809 (insert (concat name ":\n"))
91169ba7 1810 (if (and ann (not (string-equal ann "")))
e3437989
RS
1811 ;; insert the annotation, indented by 4 spaces.
1812 (progn
fd5306d2
TTN
1813 (save-excursion (insert ann) (unless (bolp)
1814 (insert "\n")))
e3437989
RS
1815 (while (< (point) (point-max))
1816 (beginning-of-line) ; paranoia
1817 (insert " ")
1818 (forward-line)
1819 (end-of-line))))))
1820 bookmark-alist)
1821 (goto-char (point-min))
1822 (pop-to-buffer old-buf)))
1823
1824
1825(defun bookmark-bmenu-mark ()
5e0e5feb 1826 "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
d22d6453
RS
1827 (interactive)
1828 (beginning-of-line)
e3437989 1829 (if (bookmark-bmenu-check-position)
175d0960 1830 (let ((inhibit-read-only t))
d22d6453
RS
1831 (delete-char 1)
1832 (insert ?>)
91169ba7
RS
1833 (forward-line 1)
1834 (bookmark-bmenu-check-position))))
d22d6453 1835
e3437989
RS
1836
1837(defun bookmark-bmenu-select ()
d22d6453 1838 "Select this line's bookmark; also display bookmarks marked with `>'.
e3437989 1839You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
d22d6453 1840 (interactive)
e3437989
RS
1841 (if (bookmark-bmenu-check-position)
1842 (let ((bmrk (bookmark-bmenu-bookmark))
dbe99ae9 1843 (menu (current-buffer))
d22d6453
RS
1844 (others ())
1845 tem)
1846 (goto-char (point-min))
1847 (while (re-search-forward "^>" nil t)
e3437989 1848 (setq tem (bookmark-bmenu-bookmark))
175d0960 1849 (let ((inhibit-read-only t))
d22d6453 1850 (delete-char -1)
d32ff76a 1851 (insert ?\s))
dbe99ae9
SS
1852 (or (string-equal tem bmrk)
1853 (member tem others)
d22d6453
RS
1854 (setq others (cons tem others))))
1855 (setq others (nreverse others)
1856 tem (/ (1- (frame-height)) (1+ (length others))))
1857 (delete-other-windows)
1858 (bookmark-jump bmrk)
1859 (bury-buffer menu)
4eadcdf8
RS
1860 (if others
1861 (while others
1862 (split-window nil tem)
1863 (other-window 1)
1864 (bookmark-jump (car others))
1865 (setq others (cdr others)))
d22d6453
RS
1866 (other-window 1)))))
1867
e3437989
RS
1868
1869(defun bookmark-bmenu-save (parg)
d22d6453
RS
1870 "Save the current list into a bookmark file.
1871With a prefix arg, prompts for a file to save them in."
1872 (interactive "P")
1873 (save-excursion
1874 (save-window-excursion
1875 (bookmark-save parg))))
1876
e3437989
RS
1877
1878(defun bookmark-bmenu-load ()
1879 "Load the bookmark file and rebuild the bookmark menu-buffer."
d22d6453 1880 (interactive)
e3437989 1881 (if (bookmark-bmenu-check-position)
d22d6453
RS
1882 (save-excursion
1883 (save-window-excursion
e3437989 1884 ;; This will call `bookmark-bmenu-list'
d22d6453
RS
1885 (call-interactively 'bookmark-load)))))
1886
e3437989
RS
1887
1888(defun bookmark-bmenu-1-window ()
d22d6453
RS
1889 "Select this line's bookmark, alone, in full frame."
1890 (interactive)
e3437989 1891 (if (bookmark-bmenu-check-position)
d22d6453 1892 (progn
e3437989 1893 (bookmark-jump (bookmark-bmenu-bookmark))
d22d6453
RS
1894 (bury-buffer (other-buffer))
1895 (delete-other-windows))))
1896
e3437989
RS
1897
1898(defun bookmark-bmenu-2-window ()
d22d6453
RS
1899 "Select this line's bookmark, with previous buffer in second window."
1900 (interactive)
e3437989
RS
1901 (if (bookmark-bmenu-check-position)
1902 (let ((bmrk (bookmark-bmenu-bookmark))
d22d6453
RS
1903 (menu (current-buffer))
1904 (pop-up-windows t))
1905 (delete-other-windows)
1906 (switch-to-buffer (other-buffer))
e40e3151
KF
1907 (let* ((pair (bookmark-jump-noselect bmrk))
1908 (buff (car pair))
1909 (pos (cdr pair)))
1910 (pop-to-buffer buff)
1911 (goto-char pos))
d22d6453
RS
1912 (bury-buffer menu))))
1913
e3437989
RS
1914
1915(defun bookmark-bmenu-this-window ()
d22d6453
RS
1916 "Select this line's bookmark in this window."
1917 (interactive)
e3437989
RS
1918 (if (bookmark-bmenu-check-position)
1919 (bookmark-jump (bookmark-bmenu-bookmark))))
d22d6453 1920
e3437989
RS
1921
1922(defun bookmark-bmenu-other-window ()
d22d6453
RS
1923 "Select this line's bookmark in other window, leaving bookmark menu visible."
1924 (interactive)
e3437989
RS
1925 (let ((bookmark (bookmark-bmenu-bookmark)))
1926 (if (bookmark-bmenu-check-position)
e40e3151
KF
1927 (let* ((pair (bookmark-jump-noselect bookmark))
1928 (buff (car pair))
1929 (pos (cdr pair)))
e3437989 1930 (switch-to-buffer-other-window buff)
e40e3151
KF
1931 (goto-char pos)
1932 (set-window-point (get-buffer-window buff) pos)
1933 (bookmark-show-annotation bookmark)))))
1934
1935
1936(defun bookmark-bmenu-switch-other-window ()
1937 "Make the other window select this line's bookmark.
1938The current window remains selected."
1939 (interactive)
e197b151
RS
1940 (let ((bookmark (bookmark-bmenu-bookmark))
1941 (pop-up-windows t)
dbe99ae9 1942 same-window-buffer-names
e197b151 1943 same-window-regexps)
e40e3151
KF
1944 (if (bookmark-bmenu-check-position)
1945 (let* ((pair (bookmark-jump-noselect bookmark))
1946 (buff (car pair))
1947 (pos (cdr pair)))
1948 (display-buffer buff)
1949 (let ((o-buffer (current-buffer)))
1950 ;; save-excursion won't do
1951 (set-buffer buff)
1952 (goto-char pos)
1953 (set-window-point (get-buffer-window buff) pos)
1954 (set-buffer o-buffer))
e3437989
RS
1955 (bookmark-show-annotation bookmark)))))
1956
7e510a5e
RS
1957(defun bookmark-bmenu-other-window-with-mouse (event)
1958 "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
1959 (interactive "e")
1960 (save-excursion
1961 (set-buffer (window-buffer (posn-window (event-end event))))
1962 (save-excursion
1963 (goto-char (posn-point (event-end event)))
1964 (bookmark-bmenu-other-window))))
1965
e3437989
RS
1966
1967(defun bookmark-bmenu-show-annotation ()
1968 "Show the annotation for the current bookmark in another window."
1969 (interactive)
1970 (let ((bookmark (bookmark-bmenu-bookmark)))
1971 (if (bookmark-bmenu-check-position)
1972 (bookmark-show-annotation bookmark))))
d22d6453 1973
e3437989
RS
1974
1975(defun bookmark-bmenu-show-all-annotations ()
1976 "Show the annotation for all bookmarks in another window."
1977 (interactive)
1978 (bookmark-show-all-annotations))
1979
1980
1981(defun bookmark-bmenu-edit-annotation ()
1982 "Edit the annotation for the current bookmark in another window."
1983 (interactive)
1984 (let ((bookmark (bookmark-bmenu-bookmark)))
1985 (if (bookmark-bmenu-check-position)
1986 (bookmark-edit-annotation bookmark))))
1987
1988
e3437989 1989(defun bookmark-bmenu-unmark (&optional backup)
d22d6453 1990 "Cancel all requested operations on bookmark on this line and move down.
4eadcdf8 1991Optional BACKUP means move up."
d22d6453
RS
1992 (interactive "P")
1993 (beginning-of-line)
e3437989 1994 (if (bookmark-bmenu-check-position)
d22d6453 1995 (progn
175d0960 1996 (let ((inhibit-read-only t))
d22d6453
RS
1997 (delete-char 1)
1998 ;; any flags to reset according to circumstances? How about a
1999 ;; flag indicating whether this bookmark is being visited?
2000 ;; well, we don't have this now, so maybe later.
2001 (insert " "))
91169ba7
RS
2002 (forward-line (if backup -1 1))
2003 (bookmark-bmenu-check-position))))
d22d6453 2004
e3437989
RS
2005
2006(defun bookmark-bmenu-backup-unmark ()
d22d6453
RS
2007 "Move up and cancel all requested operations on bookmark on line above."
2008 (interactive)
2009 (forward-line -1)
e3437989 2010 (if (bookmark-bmenu-check-position)
d22d6453 2011 (progn
e3437989 2012 (bookmark-bmenu-unmark)
91169ba7
RS
2013 (forward-line -1)
2014 (bookmark-bmenu-check-position))))
d22d6453 2015
e3437989
RS
2016
2017(defun bookmark-bmenu-delete ()
5e0e5feb
RS
2018 "Mark bookmark on this line to be deleted.
2019To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
d22d6453
RS
2020 (interactive)
2021 (beginning-of-line)
e3437989 2022 (if (bookmark-bmenu-check-position)
175d0960 2023 (let ((inhibit-read-only t))
d22d6453
RS
2024 (delete-char 1)
2025 (insert ?D)
91169ba7
RS
2026 (forward-line 1)
2027 (bookmark-bmenu-check-position))))
d22d6453 2028
e3437989
RS
2029
2030(defun bookmark-bmenu-delete-backwards ()
5e0e5feb
RS
2031 "Mark bookmark on this line to be deleted, then move up one line.
2032To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
d22d6453 2033 (interactive)
e3437989 2034 (bookmark-bmenu-delete)
d22d6453 2035 (forward-line -2)
e3437989 2036 (if (bookmark-bmenu-check-position)
91169ba7
RS
2037 (forward-line 1))
2038 (bookmark-bmenu-check-position))
d22d6453 2039
e3437989
RS
2040
2041(defun bookmark-bmenu-execute-deletions ()
d22d6453
RS
2042 "Delete bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
2043 (interactive)
60d0378e 2044 (message "Deleting bookmarks...")
e3437989
RS
2045 (let ((hide-em bookmark-bmenu-toggle-filenames)
2046 (o-point (point))
2047 (o-str (save-excursion
2048 (beginning-of-line)
2049 (if (looking-at "^D")
2050 nil
2051 (buffer-substring
2052 (point)
2053 (progn (end-of-line) (point))))))
2054 (o-col (current-column)))
2055 (if hide-em (bookmark-bmenu-hide-filenames))
2056 (setq bookmark-bmenu-toggle-filenames nil)
d22d6453
RS
2057 (goto-char (point-min))
2058 (forward-line 1)
e3437989
RS
2059 (while (re-search-forward "^D" (point-max) t)
2060 (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
2061 (bookmark-bmenu-list)
2062 (setq bookmark-bmenu-toggle-filenames hide-em)
2063 (if bookmark-bmenu-toggle-filenames
2064 (bookmark-bmenu-toggle-filenames t))
2065 (if o-str
2066 (progn
2067 (goto-char (point-min))
2068 (search-forward o-str)
2069 (beginning-of-line)
2070 (forward-char o-col))
2071 (goto-char o-point))
2072 (beginning-of-line)
2073 (setq bookmark-alist-modification-count
2074 (1+ bookmark-alist-modification-count))
2075 (if (bookmark-time-to-save-p)
60d0378e
KF
2076 (bookmark-save))
2077 (message "Deleting bookmarks...done")
2078 ))
e3437989
RS
2079
2080
2081(defun bookmark-bmenu-rename ()
d22d6453
RS
2082 "Rename bookmark on current line. Prompts for a new name."
2083 (interactive)
e3437989
RS
2084 (if (bookmark-bmenu-check-position)
2085 (let ((bmrk (bookmark-bmenu-bookmark))
d22d6453
RS
2086 (thispoint (point)))
2087 (bookmark-rename bmrk)
e3437989 2088 (bookmark-bmenu-list)
d22d6453
RS
2089 (goto-char thispoint))))
2090
e3437989
RS
2091
2092(defun bookmark-bmenu-locate ()
d22d6453
RS
2093 "Display location of this bookmark. Displays in the minibuffer."
2094 (interactive)
e3437989
RS
2095 (if (bookmark-bmenu-check-position)
2096 (let ((bmrk (bookmark-bmenu-bookmark)))
8a26c165 2097 (message "%s" (bookmark-location bmrk)))))
e3437989 2098
037b0a87
KF
2099(defun bookmark-bmenu-relocate ()
2100 "Change the file path of the bookmark on the current line,
2101 prompting with completion for the new path."
2102 (interactive)
2103 (if (bookmark-bmenu-check-position)
2104 (let ((bmrk (bookmark-bmenu-bookmark))
2105 (thispoint (point)))
2106 (bookmark-relocate bmrk)
2107 (goto-char thispoint))))
d22d6453 2108
e3437989
RS
2109\f
2110;;; Menu bar stuff. Prefix is "bookmark-menu".
11eb4275 2111
e3437989
RS
2112(defun bookmark-menu-popup-paned-menu (event name entries)
2113 "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
2114That is, ENTRIES is a list of strings which appear as the choices
2115in the menu.
175d0960
SM
2116The number of panes depends on the number of entries.
2117The visible entries are truncated to `bookmark-menu-length', but the
2118strings returned are not."
2119 (let ((f-height (/ (frame-height) 2))
2120 (pane-list nil)
2121 (iter 0))
2122 (while entries
2123 (let (lst
2124 (count 0))
2125 (while (and (< count f-height) entries)
2126 (let ((str (car entries)))
2127 (push (cons
2128 (if (> (length str) bookmark-menu-length)
2129 (substring str 0 bookmark-menu-length)
2130 str)
2131 str)
2132 lst)
2133 (setq entries (cdr entries))
2134 (setq count (1+ count))))
2135 (setq iter (1+ iter))
2136 (push (cons
2137 (format "-*- %s (%d) -*-" name iter)
2138 (nreverse lst))
2139 pane-list)))
d32ff76a 2140
175d0960
SM
2141 ;; Popup the menu and return the string.
2142 (x-popup-menu event (cons (concat "-*- " name " -*-")
2143 (nreverse pane-list)))))
e3437989 2144
b3bf02fa 2145
d22d6453
RS
2146;; Thanks to Roland McGrath for fixing menubar.el so that the
2147;; following works, and for explaining what to do to make it work.
b3bf02fa 2148
7af04c89
RS
2149;; We MUST autoload EACH form used to set up this variable's value, so
2150;; that the whole job is done in loaddefs.el.
b3bf02fa 2151
5e0e5feb 2152;; Emacs menubar stuff.
09fd6588 2153
7af04c89 2154;;;###autoload
175d0960
SM
2155(defvar menu-bar-bookmark-map
2156 (let ((map (make-sparse-keymap "Bookmark functions")))
2157 (define-key map [load] '("Load a Bookmark File..." . bookmark-load))
2158 (define-key map [write] '("Save Bookmarks As..." . bookmark-write))
2159 (define-key map [save] '("Save Bookmarks" . bookmark-save))
2160 (define-key map [edit] '("Edit Bookmark List" . bookmark-bmenu-list))
b2a664c0
JL
2161 (define-key map [delete] '("Delete Bookmark..." . bookmark-delete))
2162 (define-key map [rename] '("Rename Bookmark..." . bookmark-rename))
2163 (define-key map [locate] '("Insert Location..." . bookmark-locate))
2164 (define-key map [insert] '("Insert Contents..." . bookmark-insert))
2165 (define-key map [set] '("Set Bookmark..." . bookmark-set))
2166 (define-key map [jump] '("Jump to Bookmark..." . bookmark-jump))
175d0960 2167 map))
09fd6588 2168
7af04c89 2169;;;###autoload
175d0960 2170(defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
e3437989 2171
09fd6588
KF
2172;; make bookmarks appear toward the right side of the menu.
2173(if (boundp 'menu-bar-final-items)
dbe99ae9 2174 (if menu-bar-final-items
09fd6588
KF
2175 (setq menu-bar-final-items
2176 (cons 'bookmark menu-bar-final-items)))
2177 (setq menu-bar-final-items '(bookmark)))
2178
e3437989
RS
2179;;;; end bookmark menu stuff ;;;;
2180
2181\f
2182;;; Load Hook
2183(defvar bookmark-load-hook nil
175d0960 2184 "Hook run at the end of loading bookmark.")
e3437989 2185
6192b604
KF
2186;;; Exit Hook, called from kill-emacs-hook
2187(defvar bookmark-exit-hook nil
d32ff76a
JB
2188 "Hook run when Emacs exits.")
2189
2190(define-obsolete-variable-alias 'bookmark-exit-hooks 'bookmark-exit-hook "22.1")
dbe99ae9 2191
6192b604
KF
2192(defun bookmark-exit-hook-internal ()
2193 "Save bookmark state, if necessary, at Emacs exit time.
d32ff76a
JB
2194This also runs `bookmark-exit-hook'."
2195 (run-hooks 'bookmark-exit-hook)
175d0960
SM
2196 (and bookmark-alist
2197 (bookmark-time-to-save-p t)
2198 (bookmark-save)))
6192b604
KF
2199
2200(add-hook 'kill-emacs-hook 'bookmark-exit-hook-internal)
2201
2202
e3437989 2203(run-hooks 'bookmark-load-hook)
b3bf02fa 2204
b3bf02fa 2205(provide 'bookmark)
dbe99ae9 2206
ab5796a9 2207;;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
11eb4275 2208;;; bookmark.el ends here