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