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