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