comparison lisp/packages/bookmark.el @ 153:25f70ba0133c r20-3b3

Import from CVS: tag r20-3b3
author cvs
date Mon, 13 Aug 2007 09:38:25 +0200
parents cca96a509cfe
children 28f395d8dc7a
comparison
equal deleted inserted replaced
152:4c132ee2d62b 153:25f70ba0133c
1 ;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later. 1 ;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later.
2 2
3 ;; Copyright (C) 1993, 1994, 1995 Free Software Foundation 3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation
4 4
5 ;; Author: Karl Fogel <kfogel@cyclic.com> 5 ;; Author: Karl Fogel <kfogel@red-bean.com>
6 ;; Maintainer: Karl Fogel <kfogel@cyclic.com> 6 ;; Maintainer: Karl Fogel <kfogel@red-bean.com>
7 ;; Created: July, 1993 7 ;; Created: July, 1993
8 ;; Author's Update Number: 2.6.14-x 8 ;; Author's Update Number: see variable `bookmark-version'.
9 ;; Keywords: bookmarks, placeholders, annotations 9 ;; Keywords: bookmarks, placeholders, annotations
10 10
11 ;;; Summary: 11 ;; This file is part of GNU Emacs.
12
13 ;; GNU Emacs is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 2, or (at your option)
16 ;; any later version.
17
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs; see the file COPYING. If not, write to the
25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
26 ;; Boston, MA 02111-1307, USA.
27
28 ;;; Commentary:
29
12 ;; This package is for setting "bookmarks" in files. A bookmark 30 ;; This package is for setting "bookmarks" in files. A bookmark
13 ;; associates a string with a location in a certain file. Thus, you 31 ;; associates a string with a location in a certain file. Thus, you
14 ;; can navigate your way to that location by providing the string. 32 ;; can navigate your way to that location by providing the string.
15 ;; See the "User Variables" section for customizations. 33 ;; See the "User Variables" section for customizations.
16 34
17 ;;; Copyright info:
18 ;; This file is part of GNU Emacs.
19
20 ;; GNU Emacs is free software; you can redistribute it and/or modify
21 ;; it under the terms of the GNU General Public License as published by
22 ;; the Free Software Foundation; either version 2, or (at your option)
23 ;; any later version.
24
25 ;; GNU Emacs is distributed in the hope that it will be useful,
26 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
27 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
28 ;; GNU General Public License for more details.
29
30 ;; You should have received a copy of the GNU General Public License
31 ;; along with GNU Emacs; see the file COPYING. If not, write to
32 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
33
34 ;;; Synched up with: FSF 19.30.
35 ;;; We appear to have a more recent version than FSF?
36
37 ;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and 35 ;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and
38 ;; then implementing the bookmark-current-bookmark idea. He even 36 ;; then implementing the bookmark-current-bookmark idea. He even
39 ;; sent *patches*, bless his soul... 37 ;; sent *patches*, bless his soul...
40 38
41 ;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for 39 ;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for
48 ;; And much thanks to David Hughes <djh@harston.cv.com> for many small 46 ;; And much thanks to David Hughes <djh@harston.cv.com> for many small
49 ;; suggestions and the code to implement them (like 47 ;; suggestions and the code to implement them (like
50 ;; bookmark-bmenu-check-position, and some of the Lucid compatibility 48 ;; bookmark-bmenu-check-position, and some of the Lucid compatibility
51 ;; stuff). 49 ;; stuff).
52 50
53 ;; Kudos (whatever they are) go to Jim Blandy <jimb@cyclic.com> 51 ;; Kudos (whatever they are) go to Jim Blandy <jimb@red-bean.com>
54 ;; for his eminently sensible suggestion to separate bookmark-jump 52 ;; for his eminently sensible suggestion to separate bookmark-jump
55 ;; into bookmark-jump and bookmark-jump-noselect, which made many 53 ;; into bookmark-jump and bookmark-jump-noselect, which made many
56 ;; other things cleaner as well. 54 ;; other things cleaner as well.
57 55
58 ;; Thanks to Roland McGrath for encouragement and help with defining 56 ;; Thanks to Roland McGrath for encouragement and help with defining
77 ;; Enough with the credits already, get on to the good stuff: 75 ;; Enough with the credits already, get on to the good stuff:
78 76
79 ;; FAVORITE CHINESE RESTAURANT: 77 ;; FAVORITE CHINESE RESTAURANT:
80 ;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's 78 ;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's
81 ;; Choice (both in Chicago's Chinatown). Well, both. How about you? 79 ;; Choice (both in Chicago's Chinatown). Well, both. How about you?
82
83
84 (require 'pp)
85
86 80
87 ;;;; Code: 81 ;;;; Code:
82
83 (require 'pp)
84
85 (defconst bookmark-version "2.6.4"
86 "Version number of bookmark.el. This is not related to the version
87 of Emacs bookmark comes with; it is used solely by bookmark's
88 maintainers to avoid version confusion.")
88 89
89 ;;; Misc comments: 90 ;;; Misc comments:
90 ;; 91 ;;
91 ;; If variable bookmark-use-annotations is non-nil, an annotation is 92 ;; If variable bookmark-use-annotations is non-nil, an annotation is
92 ;; queried for when setting a bookmark. 93 ;; queried for when setting a bookmark.
96 ;; the list will be presented in the order it is recorded 97 ;; the list will be presented in the order it is recorded
97 ;; (chronologically), which is actually fairly useful as well. 98 ;; (chronologically), which is actually fairly useful as well.
98 99
99 ;;; User Variables 100 ;;; User Variables
100 101
101 (defgroup bookmark nil 102 (defvar bookmark-use-annotations nil
102 "Setting, annotation and jumping to bookmarks"
103 :group 'matching)
104
105
106 (defcustom bookmark-use-annotations nil
107 "*If non-nil, saving a bookmark will query for an annotation in a 103 "*If non-nil, saving a bookmark will query for an annotation in a
108 buffer." 104 buffer.")
109 :type 'boolean 105
110 :group 'bookmark) 106
111 107 (defvar bookmark-save-flag t
112
113 (defcustom bookmark-save-flag t
114 "*Controls when Emacs saves bookmarks to a file. 108 "*Controls when Emacs saves bookmarks to a file.
115 --> Nil means never save bookmarks, except when `bookmark-save' is 109 --> Nil means never save bookmarks, except when `bookmark-save' is
116 explicitly called \(\\[bookmark-save]\). 110 explicitly called \(\\[bookmark-save]\).
117 --> t means save bookmarks when Emacs is killed. 111 --> t means save bookmarks when Emacs is killed.
118 --> Otherise, it should be a number that is the frequency with which 112 --> Otherwise, it should be a number that is the frequency with which
119 the bookmark list is saved \(i.e.: the number of times which 113 the bookmark list is saved \(i.e.: the number of times which
120 Emacs' bookmark list may be modified before it is automatically 114 Emacs' bookmark list may be modified before it is automatically
121 saved.\). If it is a number, Emacs will also automatically save 115 saved.\). If it is a number, Emacs will also automatically save
122 bookmarks when it is killed. 116 bookmarks when it is killed.
123 117
124 Therefore, the way to get it to save every time you make or delete a 118 Therefore, the way to get it to save every time you make or delete a
125 bookmark is to set this variable to 1 \(or 0, which produces the same 119 bookmark is to set this variable to 1 \(or 0, which produces the same
126 behavior.\) 120 behavior.\)
127 121
128 To specify the file in which to save them, modify the variable 122 To specify the file in which to save them, modify the variable
129 bookmark-default-file, which is `~/.emacs.bmk' by default." 123 bookmark-default-file, which is `~/.emacs.bmk' by default.")
130 :type '(choice (const nil) (const t) integer)
131 :group 'bookmark)
132 124
133 125
134 (defconst bookmark-old-default-file "~/.emacs-bkmrks" 126 (defconst bookmark-old-default-file "~/.emacs-bkmrks"
135 "*The .emacs.bmk file used to be called this.") 127 "*The .emacs.bmk file used to be called this.")
136 128
137 129
138 ;; defvarred to avoid a compilation warning: 130 ;; defvarred to avoid a compilation warning:
139 (defvar bookmark-file nil 131 (defvar bookmark-file nil
140 "Old name for `bookmark-default-file'.") 132 "Old name for `bookmark-default-file'.")
141 133
142 (defcustom bookmark-default-file 134 (defvar bookmark-default-file
143 (if (and (boundp 'bookmark-file) bookmark-file) 135 (if bookmark-file
144 ;; In case user set `bookmark-file' in her .emacs: 136 ;; In case user set `bookmark-file' in her .emacs:
145 bookmark-file 137 bookmark-file
146 (if (eq system-type 'ms-dos) 138 (convert-standard-filename "~/.emacs.bmk"))
147 "~/emacs.bmk" ; Cannot have initial dot [Yuck!] 139 "*File in which to save bookmarks by default.")
148 "~/.emacs.bmk")) 140
149 "*File in which to save bookmarks by default." 141
150 :type 'file 142 (defvar bookmark-version-control 'nospecial
151 :group 'bookmark)
152
153
154 (defcustom bookmark-version-control 'nospecial
155 "*Whether or not to make numbered backups of the bookmark file. 143 "*Whether or not to make numbered backups of the bookmark file.
156 It can have four values: t, nil, `never', and `nospecial'. 144 It can have four values: t, nil, `never', and `nospecial'.
157 The first three have the same meaning that they do for the 145 The first three have the same meaning that they do for the
158 variable `version-control', and the final value `nospecial' means just 146 variable `version-control', and the final value `nospecial' means just
159 use the value of `version-control'." 147 use the value of `version-control'.")
160 :type '(choice (const t) (const nil) (const never) (const nospecial)) 148
161 :group 'bookmark) 149
162 150 (defvar bookmark-completion-ignore-case t
163 151 "*Non-nil means bookmark functions ignore case in completion.")
164 (defcustom bookmark-completion-ignore-case t 152
165 "*Non-nil means bookmark functions ignore case in completion." 153
166 :type 'boolean 154 (defvar bookmark-sort-flag t
167 :group 'bookmark)
168
169
170 (defcustom bookmark-sort-flag t
171 "*Non-nil means that bookmarks will be displayed sorted by bookmark 155 "*Non-nil means that bookmarks will be displayed sorted by bookmark
172 name. Otherwise they will be displayed in LIFO order (that is, most 156 name. Otherwise they will be displayed in LIFO order (that is, most
173 recently set ones come first, oldest ones come last)." 157 recently set ones come first, oldest ones come last).")
174 :type 'boolean 158
175 :group 'bookmark) 159
176 160 (defvar bookmark-automatically-show-annotations t
177 161 "*Nil means don't show annotations when jumping to a bookmark.")
178 (defcustom bookmark-automatically-show-annotations t 162
179 "*Nil means don't show annotations when jumping to a bookmark." 163
180 :type 'boolean 164 (defvar bookmark-bmenu-file-column 30
181 :group 'bookmark)
182
183
184 (defcustom bookmark-bmenu-file-column 30
185 "*Column at which to display filenames in a buffer listing bookmarks. 165 "*Column at which to display filenames in a buffer listing bookmarks.
186 You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]." 166 You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames].")
187 :type 'integer 167
188 :group 'bookmark) 168
189 169 (defvar bookmark-bmenu-toggle-filenames t
190
191 (defcustom bookmark-bmenu-toggle-filenames t
192 "*Non-nil means show filenames when listing bookmarks. 170 "*Non-nil means show filenames when listing bookmarks.
193 This may result in truncated bookmark names. To disable this, put the 171 This may result in truncated bookmark names. To disable this, put the
194 following in your .emacs: 172 following in your .emacs:
195 173
196 \(setq bookmark-bmenu-toggle-filenames nil\)" 174 \(setq bookmark-bmenu-toggle-filenames nil\)")
197 :type 'boolean 175
198 :group 'bookmark) 176
199 177 (defvar bookmark-menu-length 70
200 178 "*Maximum length of a bookmark name displayed on a popup menu.")
201 (defcustom bookmark-menu-length 70
202 "*Maximum length of a bookmark name displayed on a popup menu."
203 :type 'integer
204 :group 'boolean)
205 179
206 180
207 ;;; No user-serviceable parts beyond this point. 181 ;;; No user-serviceable parts beyond this point.
208 182
209 ;; Is it XEmacs? 183 ;; Is it XEmacs?
210 (defconst bookmark-xemacsp 184 (defconst bookmark-xemacsp
211 (string-match "\\(Lucid\\|XEmacs\\)" emacs-version)) 185 (string-match "\\(Lucid\\|Xemacs\\)" emacs-version))
212 186
213 187
214 ;; Added for lucid emacs compatibility, db 188 ;; Added for lucid emacs compatibility, db
215 (or (fboundp 'defalias) (fset 'defalias 'fset)) 189 (or (fboundp 'defalias) (fset 'defalias 'fset))
216 190
217 ;; suggested for lucid compatibility by david hughes: 191 ;; suggested for lucid compatibility by david hughes:
218 (or (fboundp 'frame-height) (defalias 'frame-height 'screen-height)) 192 (or (fboundp 'frame-height) (defalias 'frame-height 'screen-height))
219 193
194 ;; This variable is probably obsolete now...
195 (or (boundp 'baud-rate)
196 ;; some random value higher than 9600
197 (setq baud-rate 19200))
198
199 ;; XEmacs apparently call this `buffer-substring-without-properties',
200 ;; sigh.
201 (or (fboundp 'buffer-substring-no-properties)
202 (if (fboundp 'buffer-substring-without-properties)
203 (fset 'buffer-substring-no-properties
204 'buffer-substring-without-properties)
205 (fset 'buffer-substring-no-properties 'buffer-substring)))
220 206
221 207
222 ;;; Keymap stuff: 208 ;;; Keymap stuff:
223 ;; some people have C-x r set to rmail or whatever. We don't want to 209 ;; some people have C-x r set to rmail or whatever. We don't want to
224 ;; assume that C-x r is a prefix map just because it's distributed 210 ;; assume that C-x r is a prefix map just because it's distributed
308 (defvar bookmarks-already-loaded nil) 294 (defvar bookmarks-already-loaded nil)
309 295
310 296
311 ;; just add the hook to make sure that people don't lose bookmarks 297 ;; just add the hook to make sure that people don't lose bookmarks
312 ;; when they kill Emacs, unless they don't want to save them. 298 ;; when they kill Emacs, unless they don't want to save them.
313 ;;;Don't ###autoload this, there's no need. -jwz 299 ;;;###autoload
314 (add-hook 'kill-emacs-hook 300 (add-hook 'kill-emacs-hook
315 (function 301 (function
316 (lambda () (and (featurep 'bookmark) 302 (lambda () (and (featurep 'bookmark)
317 bookmark-alist 303 bookmark-alist
318 (bookmark-time-to-save-p t) 304 (bookmark-time-to-save-p t)
460 (let ((cell (assq 'info-node 446 (let ((cell (assq 'info-node
461 (bookmark-get-bookmark-record bookmark)))) 447 (bookmark-get-bookmark-record bookmark))))
462 (if cell 448 (if cell
463 (setcdr cell node) 449 (setcdr cell node)
464 (nconc (bookmark-get-bookmark-record bookmark) 450 (nconc (bookmark-get-bookmark-record bookmark)
465 (list (cons 'info-node node)))))) 451 (list (cons 'info-node node)))))
452
453 (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
454 (sit-for 4)
455 )
466 456
467 457
468 (defvar bookmark-history nil 458 (defvar bookmark-history nil
469 "The history list for bookmark functions.") 459 "The history list for bookmark functions.")
470 460
500 (` (or 490 (` (or
501 (interactive-p) 491 (interactive-p)
502 (setq bookmark-history (cons (, string) bookmark-history))))) 492 (setq bookmark-history (cons (, string) bookmark-history)))))
503 493
504 494
505 (defun bookmark-make (name &optional annotation overwrite) 495 (defun bookmark-make (name &optional annotation overwrite info-node)
506 "Make a bookmark named NAME. 496 "Make a bookmark named NAME.
507 Optional second arg ANNOTATION gives it an annotation. 497 Optional second arg ANNOTATION gives it an annotation.
508 Optional third arg OVERWRITE means replace any existing bookmarks with 498 Optional third arg OVERWRITE means replace any existing bookmarks with
509 this name." 499 this name.
500 Optional fourth arg INFO-NODE means this bookmark is at info node
501 INFO-NODE, so record this fact in the bookmark's entry."
510 (bookmark-maybe-load-default-file) 502 (bookmark-maybe-load-default-file)
511 (let ((stripped-name (copy-sequence name))) 503 (let ((stripped-name (copy-sequence name)))
512 (set-text-properties 0 (length stripped-name) nil stripped-name) 504 (or bookmark-xemacsp
505 ;; XEmacs's `set-text-properties' doesn't work on
506 ;; free-standing strings, apparently.
507 (set-text-properties 0 (length stripped-name) nil stripped-name))
513 (if (and (bookmark-get-bookmark stripped-name) (not overwrite)) 508 (if (and (bookmark-get-bookmark stripped-name) (not overwrite))
514 ;; already existing boookmark under that name and 509 ;; already existing bookmark under that name and
515 ;; no prefix arg means just overwrite old bookmark 510 ;; no prefix arg means just overwrite old bookmark
516 (setcdr (bookmark-get-bookmark stripped-name) 511 (setcdr (bookmark-get-bookmark stripped-name)
517 (list (bookmark-make-cell annotation))) 512 (list (bookmark-make-cell annotation info-node)))
518 513
519 ;; otherwise just cons it onto the front (either the bookmark 514 ;; otherwise just cons it onto the front (either the bookmark
520 ;; doesn't exist already, or there is no prefix arg. In either 515 ;; doesn't exist already, or there is no prefix arg. In either
521 ;; case, we want the new bookmark consed onto the alist...) 516 ;; case, we want the new bookmark consed onto the alist...)
522 517
523 (setq bookmark-alist 518 (setq bookmark-alist
524 (cons 519 (cons
525 (list stripped-name 520 (list stripped-name
526 (bookmark-make-cell annotation)) 521 (bookmark-make-cell annotation info-node))
527 bookmark-alist))) 522 bookmark-alist)))
528 523
529 ;; Added by db 524 ;; Added by db
530 (setq bookmark-current-bookmark stripped-name) 525 (setq bookmark-current-bookmark stripped-name)
531 (setq bookmark-alist-modification-count 526 (setq bookmark-alist-modification-count
532 (1+ bookmark-alist-modification-count)) 527 (1+ bookmark-alist-modification-count))
533 (if (bookmark-time-to-save-p) 528 (if (bookmark-time-to-save-p)
534 (bookmark-save)))) 529 (bookmark-save))))
535 530
536 531
537 (defun bookmark-make-cell (annotation) 532 (defun bookmark-make-cell (annotation &optional info-node)
538 "Return the record part of a new bookmark, given ANNOTATION. 533 "Return the record part of a new bookmark, given ANNOTATION.
539 Must be at the correct position in the buffer in which the bookmark is 534 Must be at the correct position in the buffer in which the bookmark is
540 being set. This will change soon." 535 being set. This might change someday.
541 (` ((filename . (, (bookmark-buffer-file-name))) 536 Optional second arg INFO-NODE means this bookmark is at info node
542 (front-context-string 537 INFO-NODE, so record this fact in the bookmark's entry."
543 . (, (if (>= (- (point-max) (point)) bookmark-search-size) 538 (let ((the-record
544 (buffer-substring-no-properties 539 (` ((filename . (, (bookmark-buffer-file-name)))
545 (point) 540 (front-context-string
546 (+ (point) bookmark-search-size)) 541 . (, (if (>= (- (point-max) (point)) bookmark-search-size)
547 nil))) 542 (buffer-substring-no-properties
548 (rear-context-string 543 (point)
549 . (, (if (>= (- (point) (point-min)) bookmark-search-size) 544 (+ (point) bookmark-search-size))
550 (buffer-substring-no-properties 545 nil)))
551 (point) 546 (rear-context-string
552 (- (point) bookmark-search-size)) 547 . (, (if (>= (- (point) (point-min)) bookmark-search-size)
553 nil))) 548 (buffer-substring-no-properties
554 (position . (, (point))) 549 (point)
555 (annotation . (, annotation))))) 550 (- (point) bookmark-search-size))
551 nil)))
552 (position . (, (point)))
553 ))))
554
555 ;; Now fill in the optional parts:
556 (if annotation
557 (nconc the-record (list (cons 'annotation annotation))))
558 (if info-node
559 (nconc the-record (list (cons 'info-node info-node))))
560
561 ;; Finally, return the completed record.
562 the-record))
563
556 564
557 565
558 ;;; File format stuff 566 ;;; File format stuff
559 567
560 ;; The OLD format of the bookmark-alist was: 568 ;; The OLD format of the bookmark-alist was:
597 ;; The context strings exist so that modifications to a file don't 605 ;; The context strings exist so that modifications to a file don't
598 ;; necessarily cause a bookmark's position to be invalidated. 606 ;; necessarily cause a bookmark's position to be invalidated.
599 ;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in 607 ;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
600 ;; case the file has changed since the bookmark was set. It will 608 ;; case the file has changed since the bookmark was set. It will
601 ;; attempt to place the user before the changes, if there were any. 609 ;; attempt to place the user before the changes, if there were any.
602 ;; annotation is the annotation for the bookmark; it may not exist 610 ;; ANNOTATION is the annotation for the bookmark; it may not exist
603 ;; (for backward compatibility), be nil (no annotation), or be a 611 ;; (for backward compatibility), be nil (no annotation), or be a
604 ;; string. 612 ;; string.
605 ;;
606 ;; ANNOTATION is an annotation for the bookmark.
607 613
608 614
609 (defconst bookmark-file-format-version 1 615 (defconst bookmark-file-format-version 1
610 "The current version of the format used by bookmark files. 616 "The current version of the format used by bookmark files.
611 You should never need to change this.") 617 You should never need to change this.")
629 (if (search-forward "(" nil t) 635 (if (search-forward "(" nil t)
630 (progn 636 (progn
631 (forward-char -1) 637 (forward-char -1)
632 (read (current-buffer))) 638 (read (current-buffer)))
633 ;; Else no hope of getting information here. 639 ;; Else no hope of getting information here.
634 (error "Not bookmark format."))))) 640 (error "Not bookmark format")))))
635 641
636 642
637 (defun bookmark-upgrade-version-0-alist (old-list) 643 (defun bookmark-upgrade-version-0-alist (old-list)
638 "Upgrade a version 0 alist OLD-LIST to the current version." 644 "Upgrade a version 0 alist OLD-LIST to the current version."
639 (mapcar 645 (mapcar
665 (delete-region (point-min) (point-max)) 671 (delete-region (point-min) (point-max))
666 (bookmark-insert-file-format-version-stamp) 672 (bookmark-insert-file-format-version-stamp)
667 (pp new-list (current-buffer)) 673 (pp new-list (current-buffer))
668 (save-buffer)) 674 (save-buffer))
669 (goto-char (point-min)) 675 (goto-char (point-min))
670 (message "Upgrading bookmark format from 0 to %d... done." 676 (message "Upgrading bookmark format from 0 to %d...done"
671 bookmark-file-format-version) 677 bookmark-file-format-version)
672 ) 678 )
673 679
674 680
675 (defun bookmark-grok-file-format-version () 681 (defun bookmark-grok-file-format-version ()
695 ((= version bookmark-file-format-version) 701 ((= version bookmark-file-format-version)
696 ) ; home free -- version is current 702 ) ; home free -- version is current
697 ((= version 0) 703 ((= version 0)
698 (bookmark-upgrade-file-format-from-0)) 704 (bookmark-upgrade-file-format-from-0))
699 (t 705 (t
700 (error "Bookmark file format version strangeness."))))) 706 (error "Bookmark file format version strangeness")))))
701 707
702 708
703 (defun bookmark-insert-file-format-version-stamp () 709 (defun bookmark-insert-file-format-version-stamp ()
704 "Insert text indicating current version of bookmark file-format." 710 "Insert text indicating current version of bookmark file format."
705 (insert 711 (insert
706 (format ";;;; Emacs Bookmark Format Version %d ;;;;\n" 712 (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
707 bookmark-file-format-version)) 713 bookmark-file-format-version))
708 (insert ";;; This format is meant to be slightly human-readable;\n" 714 (insert ";;; This format is meant to be slightly human-readable;\n"
709 ";;; nevertheless, you probably don't want to edit it.\n" 715 ";;; nevertheless, you probably don't want to edit it.\n"
740 and it removes only the first instance of a bookmark with that name from 746 and it removes only the first instance of a bookmark with that name from
741 the list of bookmarks.\)" 747 the list of bookmarks.\)"
742 (interactive (list nil current-prefix-arg)) 748 (interactive (list nil current-prefix-arg))
743 (or 749 (or
744 (bookmark-buffer-file-name) 750 (bookmark-buffer-file-name)
745 (error "Buffer not visiting a file or directory.")) 751 (error "Buffer not visiting a file or directory"))
746 752
747 (bookmark-maybe-load-default-file) 753 (bookmark-maybe-load-default-file)
748 754
749 (setq bookmark-current-point (point)) 755 (setq bookmark-current-point (point))
750 (setq bookmark-yank-point (point)) 756 (setq bookmark-yank-point (point))
767 (and (string-equal str "") (setq str default)) 773 (and (string-equal str "") (setq str default))
768 ;; Ask for an annotation buffer for this bookmark 774 ;; Ask for an annotation buffer for this bookmark
769 (if bookmark-use-annotations 775 (if bookmark-use-annotations
770 (bookmark-read-annotation parg str) 776 (bookmark-read-annotation parg str)
771 (progn 777 (progn
772 (bookmark-make str annotation parg) 778 (bookmark-make str annotation parg (bookmark-info-current-node))
773 ;; In Info, there's a little more information to record:
774 (if (eq major-mode 'Info-mode)
775 (bookmark-set-info-node str Info-current-node))
776 (setq bookmark-current-bookmark str) 779 (setq bookmark-current-bookmark str)
777 (bookmark-bmenu-surreptitiously-rebuild-list) 780 (bookmark-bmenu-surreptitiously-rebuild-list)
778 (goto-char bookmark-current-point))))) 781 (goto-char bookmark-current-point)))))
782
783
784 (defun bookmark-info-current-node ()
785 "If in Info-mode, return current node name (a string), else nil."
786 (if (eq major-mode 'Info-mode)
787 Info-current-node))
779 788
780 789
781 (defun bookmark-kill-line (&optional newline-too) 790 (defun bookmark-kill-line (&optional newline-too)
782 "Kill from point to end of line. 791 "Kill from point to end of line.
783 If optional arg NEWLINE-TOO is non-nil, delete the newline too. 792 If optional arg NEWLINE-TOO is non-nil, delete the newline too.
795 (defvar bookmark-annotation-file nil) 804 (defvar bookmark-annotation-file nil)
796 (defvar bookmark-annotation-point nil) 805 (defvar bookmark-annotation-point nil)
797 806
798 807
799 (defun bookmark-send-annotation () 808 (defun bookmark-send-annotation ()
800 "After remove lines beginning with '#', use the contents of this buffer 809 "Use buffer contents as the annotation for a bookmark.
801 as the annotation for a bookmark, and store it in the bookmark list with 810 Exclude lines that begin with `#'.
811 Store the annotation text in the bookmark list with
802 the bookmark (and file, and point) specified in buffer local variables." 812 the bookmark (and file, and point) specified in buffer local variables."
803 (interactive) 813 (interactive)
804 (if (not (eq major-mode 'bookmark-read-annotation-mode)) 814 (if (not (eq major-mode 'bookmark-read-annotation-mode))
805 (error "Not in bookmark-read-annotation-mode.")) 815 (error "Not in bookmark-read-annotation-mode"))
806 (goto-char (point-min)) 816 (goto-char (point-min))
807 (while (< (point) (point-max)) 817 (while (< (point) (point-max))
808 (if (looking-at "^#") 818 (if (looking-at "^#")
809 (bookmark-kill-line t) 819 (bookmark-kill-line t)
810 (forward-line 1))) 820 (forward-line 1)))
819 ;; to avoid this need. Should I handle the error if a buffer is 829 ;; to avoid this need. Should I handle the error if a buffer is
820 ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer? 830 ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
821 (save-excursion 831 (save-excursion
822 (pop-to-buffer buf) 832 (pop-to-buffer buf)
823 (goto-char pt) 833 (goto-char pt)
824 (bookmark-make bookmark annotation parg) 834 (bookmark-make bookmark annotation parg (bookmark-info-current-node))
825 (setq bookmark-current-bookmark bookmark)) 835 (setq bookmark-current-bookmark bookmark))
826 (bookmark-bmenu-surreptitiously-rebuild-list) 836 (bookmark-bmenu-surreptitiously-rebuild-list)
827 (goto-char bookmark-current-point)) 837 (goto-char bookmark-current-point))
828 (kill-buffer (current-buffer))) 838 (kill-buffer (current-buffer)))
829 839
836 (system-name) ">\n" 846 (system-name) ">\n"
837 "# Date: " (current-time-string) "\n")) 847 "# Date: " (current-time-string) "\n"))
838 848
839 849
840 (defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text 850 (defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text
841 "A variable containing a function which returns the text to insert 851 "Function to return default text to use for a bookmark annotation.
842 into an annotation compisition buffer. It takes the name of the bookmark, 852 It takes the name of the bookmark, as a string, as an arg.")
843 as a string, as an arg.")
844
845 853
846 (defun bookmark-read-annotation-mode (buf point parg bookmark) 854 (defun bookmark-read-annotation-mode (buf point parg bookmark)
847 "Mode for composing annotations for a bookmark. 855 "Mode for composing annotations for a bookmark.
848 Wants BUF POINT PARG and BOOKMARK. 856 Wants BUF POINT PARG and BOOKMARK.
849 When you have finished composing, type \\[bookmark-send-annotation] to send 857 When you have finished composing, type \\[bookmark-send-annotation] to send
868 (insert (funcall bookmark-read-annotation-text-func bookmark)) 876 (insert (funcall bookmark-read-annotation-text-func bookmark))
869 (run-hooks 'text-mode-hook)) 877 (run-hooks 'text-mode-hook))
870 878
871 879
872 (defun bookmark-read-annotation (parg bookmark) 880 (defun bookmark-read-annotation (parg bookmark)
873 "Pop up a buffer for entering a bookmark annotation. Text surrounding 881 "Pop up a buffer for entering a bookmark annotation.
874 the bookmark is PARG; the bookmark name is BOOKMARK." 882 Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK."
875 (let ((buf (current-buffer)) 883 (let ((buf (current-buffer))
876 (point (point))) 884 (point (point)))
877 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) 885 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
878 (bookmark-read-annotation-mode buf point parg bookmark))) 886 (bookmark-read-annotation-mode buf point parg bookmark)))
879 887
905 (insert annotation))) 913 (insert annotation)))
906 (run-hooks 'text-mode-hook)) 914 (run-hooks 'text-mode-hook))
907 915
908 916
909 (defun bookmark-send-edited-annotation () 917 (defun bookmark-send-edited-annotation ()
910 "After remove lines beginning with '#', use the contents of this buffer 918 "Use buffer contents (minus beginning with `#' as annotation for a bookmark."
911 as the new annotation for a bookmark."
912 (interactive) 919 (interactive)
913 (if (not (eq major-mode 'bookmark-edit-annotation-mode)) 920 (if (not (eq major-mode 'bookmark-edit-annotation-mode))
914 (error "Not in bookmark-edit-annotation-mode.")) 921 (error "Not in bookmark-edit-annotation-mode"))
915 (goto-char (point-min)) 922 (goto-char (point-min))
916 (while (< (point) (point-max)) 923 (while (< (point) (point-max))
917 (if (looking-at "^#") 924 (if (looking-at "^#")
918 (bookmark-kill-line t) 925 (bookmark-kill-line t)
919 (forward-line 1))) 926 (forward-line 1)))
932 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*")) 939 (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
933 (bookmark-edit-annotation-mode bookmark))) 940 (bookmark-edit-annotation-mode bookmark)))
934 941
935 942
936 (defun bookmark-insert-current-bookmark () 943 (defun bookmark-insert-current-bookmark ()
937 "Insert this buffer's value of bookmark-current-bookmark, default 944 "Insert this buffer's value of bookmark-current-bookmark.
938 to file name if it's nil." 945 Default to file name if it's nil."
939 (interactive) 946 (interactive)
940 (let ((str 947 (let ((str
941 (save-excursion 948 (save-excursion
942 (set-buffer bookmark-current-buffer) 949 (set-buffer bookmark-current-buffer)
943 bookmark-current-bookmark))) 950 bookmark-current-bookmark)))
944 (if str (insert str) (bookmark-insert-buffer-name)))) 951 (if str (insert str) (bookmark-insert-buffer-name))))
945 952
946 953
947 (defun bookmark-insert-buffer-name () 954 (defun bookmark-insert-buffer-name ()
948 "Insert the name (sans path) of the current file into the bookmark 955 "Insert the current file name into the bookmark name being set.
949 name that is being set." 956 The directory part of the file name is not used."
950 (interactive) 957 (interactive)
951 (let ((str 958 (let ((str
952 (save-excursion 959 (save-excursion
953 (set-buffer bookmark-current-buffer) 960 (set-buffer bookmark-current-buffer)
954 (bookmark-buffer-name)))) 961 (bookmark-buffer-name))))
1008 1015
1009 1016
1010 (defun bookmark-maybe-load-default-file () 1017 (defun bookmark-maybe-load-default-file ()
1011 (and (not bookmarks-already-loaded) 1018 (and (not bookmarks-already-loaded)
1012 (null bookmark-alist) 1019 (null bookmark-alist)
1013
1014 (prog2 1020 (prog2
1015 (and 1021 (and
1016 ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs 1022 ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
1017 ;; to be renamed. 1023 ;; to be renamed.
1018 (file-exists-p (expand-file-name bookmark-old-default-file)) 1024 (file-exists-p (expand-file-name bookmark-old-default-file))
1106 ;; Rationale is that if text was inserted between the two in the 1112 ;; Rationale is that if text was inserted between the two in the
1107 ;; file, it's better to be put before it so you can read it, 1113 ;; file, it's better to be put before it so you can read it,
1108 ;; rather than after and remain perhaps unaware of the changes. 1114 ;; rather than after and remain perhaps unaware of the changes.
1109 (if forward-str 1115 (if forward-str
1110 (if (search-forward forward-str (point-max) t) 1116 (if (search-forward forward-str (point-max) t)
1111 (backward-char (length forward-str)))) 1117 (goto-char (match-beginning 0))))
1112 (if behind-str 1118 (if behind-str
1113 (if (search-backward behind-str (point-min) t) 1119 (if (search-backward behind-str (point-min) t)
1114 (forward-char (length behind-str)))) 1120 (goto-char (match-end 0))))
1115 ;; added by db 1121 ;; added by db
1116 (setq bookmark-current-bookmark str) 1122 (setq bookmark-current-bookmark str)
1117 (cons (current-buffer) (point))) 1123 (cons (current-buffer) (point)))
1118 (progn 1124 (progn
1119 (ding) 1125 (ding)
1130 nil))))) 1136 nil)))))
1131 1137
1132 1138
1133 ;;;###autoload 1139 ;;;###autoload
1134 (defun bookmark-relocate (bookmark) 1140 (defun bookmark-relocate (bookmark)
1135 "Relocate BOOKMARK -- prompts for a filename, and makes an already 1141 "Relocate BOOKMARK to another file (reading file name with minibuffer).
1136 existing bookmark point to that file, instead of the one it used to 1142 This makes an already existing bookmark point to that file, instead of
1137 point at. Useful when a file has been renamed after a bookmark was 1143 the one it used to point at. Useful when a file has been renamed
1138 set in it." 1144 after a bookmark was set in it."
1139 (interactive (bookmark-completing-read "Bookmark to relocate")) 1145 (interactive (bookmark-completing-read "Bookmark to relocate"))
1140 (bookmark-maybe-historicize-string bookmark) 1146 (bookmark-maybe-historicize-string bookmark)
1141 (bookmark-maybe-load-default-file) 1147 (bookmark-maybe-load-default-file)
1142 (let* ((bmrk-filename (bookmark-get-filename bookmark)) 1148 (let* ((bmrk-filename (bookmark-get-filename bookmark))
1143 (newloc (expand-file-name 1149 (newloc (expand-file-name
1152 "Insert the name of the file associated with BOOKMARK. 1158 "Insert the name of the file associated with BOOKMARK.
1153 Optional second arg NO-HISTORY means don't record this in the 1159 Optional second arg NO-HISTORY means don't record this in the
1154 minibuffer history list `bookmark-history'." 1160 minibuffer history list `bookmark-history'."
1155 (interactive (bookmark-completing-read "Insert bookmark location")) 1161 (interactive (bookmark-completing-read "Insert bookmark location"))
1156 (or no-history (bookmark-maybe-historicize-string bookmark)) 1162 (or no-history (bookmark-maybe-historicize-string bookmark))
1157 (insert (bookmark-location bookmark))) 1163 (let ((start (point)))
1158 1164 (prog1
1165 (insert (bookmark-location bookmark)) ; *Return this line*
1166 (if window-system
1167 (put-text-property start
1168 (save-excursion (re-search-backward
1169 "[^ \t]")
1170 (1+ (point)))
1171 'mouse-face 'highlight)))))
1172
1173 ;;;###autoload
1174 (defalias 'bookmark-locate 'bookmark-insert-location)
1159 1175
1160 (defun bookmark-location (bookmark) 1176 (defun bookmark-location (bookmark)
1161 "Return the name of the file associated with BOOKMARK." 1177 "Return the name of the file associated with BOOKMARK."
1162 (bookmark-maybe-load-default-file) 1178 (bookmark-maybe-load-default-file)
1163 (bookmark-get-filename bookmark)) 1179 (bookmark-get-filename bookmark))
1164 1180
1165 1181
1166 ;;;###autoload 1182 ;;;###autoload
1167 (defun bookmark-rename (old &optional new) 1183 (defun bookmark-rename (old &optional new)
1168 "Change the name of OLD bookmark to NEW name. If called from 1184 "Change the name of OLD bookmark to NEW name.
1169 keyboard, prompts for OLD and NEW. If called from menubar, OLD is 1185 If called from keyboard, prompt for OLD and NEW. If called from
1170 selected from a menu, and prompts for NEW. 1186 menubar, select OLD from a menu and prompt for NEW.
1171 1187
1172 If called from Lisp, prompts for NEW if only OLD was passed as an 1188 If called from Lisp, prompt for NEW if only OLD was passed as an
1173 argument. If called with two strings, then no prompting is done. You 1189 argument. If called with two strings, then no prompting is done. You
1174 must pass at least OLD when calling from Lisp. 1190 must pass at least OLD when calling from Lisp.
1175 1191
1176 While you are entering the new name, consecutive C-w's insert 1192 While you are entering the new name, consecutive C-w's insert
1177 consecutive words from the text of the buffer into the new bookmark 1193 consecutive words from the text of the buffer into the new bookmark
1268 nil))) 1284 nil)))
1269 1285
1270 1286
1271 ;;;###autoload 1287 ;;;###autoload
1272 (defun bookmark-write () 1288 (defun bookmark-write ()
1273 "Write bookmarks to a file \(for which the user will be prompted 1289 "Write bookmarks to a file (reading the file name with the minibuffer).
1274 interactively\). Don't use this in Lisp programs; use bookmark-save 1290 Don't use this in Lisp programs; use `bookmark-save' instead."
1275 instead."
1276 (interactive) 1291 (interactive)
1277 (bookmark-maybe-load-default-file) 1292 (bookmark-maybe-load-default-file)
1278 (bookmark-save t)) 1293 (bookmark-save t))
1279 1294
1280 1295
1318 1333
1319 1334
1320 (defun bookmark-write-file (file) 1335 (defun bookmark-write-file (file)
1321 (save-excursion 1336 (save-excursion
1322 (save-window-excursion 1337 (save-window-excursion
1323 (if (>= (device-baud-rate) 9600) 1338 (if (>= baud-rate 9600)
1324 (message "Saving bookmarks to file %s..." file)) 1339 (message "Saving bookmarks to file %s..." file))
1325 (set-buffer (let ((enable-local-variables nil)) 1340 (set-buffer (let ((enable-local-variables nil))
1326 (find-file-noselect file))) 1341 (find-file-noselect file)))
1327 (goto-char (point-min)) 1342 (goto-char (point-min))
1328 (delete-region (point-min) (point-max)) 1343 (delete-region (point-min) (point-max))
1335 ((eq 'nospecial bookmark-version-control) version-control) 1350 ((eq 'nospecial bookmark-version-control) version-control)
1336 (t 1351 (t
1337 t)))) 1352 t))))
1338 (write-file file) 1353 (write-file file)
1339 (kill-buffer (current-buffer)) 1354 (kill-buffer (current-buffer))
1340 (if (>= (device-baud-rate) 9600) 1355 (if (>= baud-rate 9600)
1341 (message "Saving bookmarks to file %s... done." file)) 1356 (message "Saving bookmarks to file %s...done" file))
1342 )))) 1357 ))))
1343 1358
1344 1359
1345 ;;;###autoload 1360 ;;;###autoload
1346 (defun bookmark-load (file &optional revert no-msg) 1361 (defun bookmark-load (file &optional revert no-msg)
1366 "~/" bookmark-default-file 'confirm))) 1381 "~/" bookmark-default-file 'confirm)))
1367 (setq file (expand-file-name file)) 1382 (setq file (expand-file-name file))
1368 (if (file-readable-p file) 1383 (if (file-readable-p file)
1369 (save-excursion 1384 (save-excursion
1370 (save-window-excursion 1385 (save-window-excursion
1371 (if (and (null no-msg) (>= (device-baud-rate) 9600)) 1386 (if (and (null no-msg) (>= baud-rate 9600))
1372 (message "Loading bookmarks from %s..." file)) 1387 (message "Loading bookmarks from %s..." file))
1373 (set-buffer (let ((enable-local-variables nil)) 1388 (set-buffer (let ((enable-local-variables nil))
1374 (find-file-noselect file))) 1389 (find-file-noselect file)))
1375 (goto-char (point-min)) 1390 (goto-char (point-min))
1376 (bookmark-maybe-upgrade-file-format) 1391 (bookmark-maybe-upgrade-file-format)
1382 (1+ bookmark-alist-modification-count)) 1397 (1+ bookmark-alist-modification-count))
1383 (setq bookmark-alist-modification-count 0)) 1398 (setq bookmark-alist-modification-count 0))
1384 (setq bookmark-alist 1399 (setq bookmark-alist
1385 (append blist (if (not revert) bookmark-alist))) 1400 (append blist (if (not revert) bookmark-alist)))
1386 (bookmark-bmenu-surreptitiously-rebuild-list)) 1401 (bookmark-bmenu-surreptitiously-rebuild-list))
1387 (error "Invalid bookmark list in %s." file))) 1402 (error "Invalid bookmark list in %s" file)))
1388 (kill-buffer (current-buffer))) 1403 (kill-buffer (current-buffer)))
1389 (if (and (null no-msg) (>= (device-baud-rate) 9600)) 1404 (if (and (null no-msg) (>= baud-rate 9600))
1390 (message "Loading bookmarks from %s... done" file))) 1405 (message "Loading bookmarks from %s...done" file)))
1391 (error "Cannot read bookmark file %s." file))) 1406 (error "Cannot read bookmark file %s" file)))
1392 1407
1393 1408
1394 1409
1395 ;;; Code supporting the dired-like bookmark menu. Prefix is 1410 ;;; Code supporting the dired-like bookmark menu. Prefix is
1396 ;;; "bookmark-bmenu" for "buffer-menu": 1411 ;;; "bookmark-bmenu" for "buffer-menu":
1413 (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select) 1428 (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
1414 (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate) 1429 (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
1415 (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window) 1430 (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
1416 (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window) 1431 (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window)
1417 (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window) 1432 (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
1433 (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
1418 (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window) 1434 (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
1419 (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window) 1435 (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
1420 (define-key bookmark-bmenu-mode-map "\C-o" 'bookmark-bmenu-switch-other-window) 1436 (define-key bookmark-bmenu-mode-map "\C-o"
1437 'bookmark-bmenu-switch-other-window)
1421 (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save) 1438 (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save)
1422 (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete) 1439 (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete)
1423 (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards) 1440 (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards)
1424 (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions) 1441 (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions)
1425 (define-key bookmark-bmenu-mode-map "\C-k" 'bookmark-bmenu-delete)
1426 (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete) 1442 (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete)
1427 (define-key bookmark-bmenu-mode-map " " 'next-line) 1443 (define-key bookmark-bmenu-mode-map " " 'next-line)
1428 (define-key bookmark-bmenu-mode-map "n" 'next-line) 1444 (define-key bookmark-bmenu-mode-map "n" 'next-line)
1429 (define-key bookmark-bmenu-mode-map "p" 'previous-line) 1445 (define-key bookmark-bmenu-mode-map "p" 'previous-line)
1430 (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark) 1446 (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark)
1434 (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load) 1450 (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
1435 (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename) 1451 (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
1436 (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames) 1452 (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
1437 (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation) 1453 (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
1438 (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations) 1454 (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
1439 (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)) 1455 (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)
1456 (define-key bookmark-bmenu-mode-map [mouse-2]
1457 'bookmark-bmenu-other-window-with-mouse))
1440 1458
1441 1459
1442 1460
1443 ;; Bookmark Buffer Menu mode is suitable only for specially formatted 1461 ;; Bookmark Buffer Menu mode is suitable only for specially formatted
1444 ;; data. 1462 ;; data.
1477 (goto-char (point-min)) ;sure are playing it safe... 1495 (goto-char (point-min)) ;sure are playing it safe...
1478 (insert "% Bookmark\n- --------\n") 1496 (insert "% Bookmark\n- --------\n")
1479 (bookmark-maybe-sort-alist) 1497 (bookmark-maybe-sort-alist)
1480 (mapcar 1498 (mapcar
1481 (lambda (full-record) 1499 (lambda (full-record)
1482 ;; if a bookmark has an annotation, precede it with a "*" 1500 ;; if a bookmark has an annotation, prepend a "*"
1483 ;; in the list of bookmarks. 1501 ;; in the list of bookmarks.
1484 (let ((annotation (bookmark-get-annotation 1502 (let ((annotation (bookmark-get-annotation
1485 (bookmark-name-from-full-record full-record)))) 1503 (bookmark-name-from-full-record full-record))))
1486 (if (and (not (eq annotation nil)) 1504 (if (and (not (eq annotation nil))
1487 (not (string-equal annotation ""))) 1505 (not (string-equal annotation "")))
1488 (insert " *") 1506 (insert " *")
1489 (insert " ")) 1507 (insert " "))
1490 (insert (concat (bookmark-name-from-full-record full-record) "\n")))) 1508 (let ((start (point)))
1509 (insert (bookmark-name-from-full-record full-record))
1510 (if window-system
1511 (put-text-property start
1512 (save-excursion (re-search-backward
1513 "[^ \t]")
1514 (1+ (point)))
1515 'mouse-face 'highlight))
1516 (insert "\n")
1517 )))
1491 bookmark-alist)) 1518 bookmark-alist))
1492 (goto-char (point-min)) 1519 (goto-char (point-min))
1493 (forward-line 2) 1520 (forward-line 2)
1494 (bookmark-bmenu-mode) 1521 (bookmark-bmenu-mode)
1495 (if bookmark-bmenu-toggle-filenames 1522 (if bookmark-bmenu-toggle-filenames
1521 so the bookmark menu bookmark remains visible in its window. 1548 so the bookmark menu bookmark remains visible in its window.
1522 \\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark. 1549 \\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
1523 \\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\). 1550 \\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
1524 \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down. 1551 \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
1525 \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up. 1552 \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
1526 \\[bookmark-bmenu-execute-deletions] -- delete marked bookmarks. 1553 \\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
1527 \\[bookmark-bmenu-save] -- save the current bookmark list in the default file. 1554 \\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
1528 With a prefix arg, prompts for a file to save in. 1555 With a prefix arg, prompts for a file to save in.
1529 \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.) 1556 \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
1530 \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line. 1557 \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
1531 With prefix argument, also move up one line. 1558 With prefix argument, also move up one line.
1571 (let ((buffer-read-only nil)) 1598 (let ((buffer-read-only nil))
1572 (while (< (point) (point-max)) 1599 (while (< (point) (point-max))
1573 (let ((bmrk (bookmark-bmenu-bookmark))) 1600 (let ((bmrk (bookmark-bmenu-bookmark)))
1574 (setq bookmark-bmenu-hidden-bookmarks 1601 (setq bookmark-bmenu-hidden-bookmarks
1575 (cons bmrk bookmark-bmenu-hidden-bookmarks)) 1602 (cons bmrk bookmark-bmenu-hidden-bookmarks))
1576 (move-to-column bookmark-bmenu-file-column t) 1603 (let ((start (save-excursion (end-of-line) (point))))
1577 (delete-region (point) (progn (end-of-line) (point))) 1604 (move-to-column bookmark-bmenu-file-column t)
1605 ;; Strip off `mouse-face' from the white spaces region.
1606 (if window-system
1607 (remove-text-properties start (point)
1608 '(mouse-face))))
1609 (delete-region (point) (progn (end-of-line) (point)))
1578 (insert " ") 1610 (insert " ")
1579 ;; Pass the NO-HISTORY arg: 1611 ;; Pass the NO-HISTORY arg:
1580 (bookmark-insert-location bmrk t) 1612 (bookmark-insert-location bmrk t)
1581 (forward-line 1)))))))) 1613 (forward-line 1))))))))
1582 1614
1598 (save-excursion 1630 (save-excursion
1599 (let ((buffer-read-only nil)) 1631 (let ((buffer-read-only nil))
1600 (while bookmark-bmenu-hidden-bookmarks 1632 (while bookmark-bmenu-hidden-bookmarks
1601 (move-to-column bookmark-bmenu-bookmark-column t) 1633 (move-to-column bookmark-bmenu-bookmark-column t)
1602 (bookmark-kill-line) 1634 (bookmark-kill-line)
1603 (insert (car bookmark-bmenu-hidden-bookmarks)) 1635 (let ((start (point)))
1636 (insert (car bookmark-bmenu-hidden-bookmarks))
1637 (if window-system
1638 (put-text-property start
1639 (save-excursion (re-search-backward
1640 "[^ \t]")
1641 (1+ (point)))
1642 'mouse-face 'highlight)))
1604 (setq bookmark-bmenu-hidden-bookmarks 1643 (setq bookmark-bmenu-hidden-bookmarks
1605 (cdr bookmark-bmenu-hidden-bookmarks)) 1644 (cdr bookmark-bmenu-hidden-bookmarks))
1606 (forward-line 1)))))))) 1645 (forward-line 1))))))))
1607 1646
1608 1647
1638 (save-excursion 1677 (save-excursion
1639 (save-window-excursion 1678 (save-window-excursion
1640 (beginning-of-line) 1679 (beginning-of-line)
1641 (forward-char bookmark-bmenu-bookmark-column) 1680 (forward-char bookmark-bmenu-bookmark-column)
1642 (prog1 1681 (prog1
1643 (buffer-substring (point) 1682 (buffer-substring-no-properties (point)
1644 (progn 1683 (progn
1645 (end-of-line) 1684 (end-of-line)
1646 (point))) 1685 (point)))
1647 ;; well, this is certainly crystal-clear: 1686 ;; well, this is certainly crystal-clear:
1648 (if bookmark-bmenu-toggle-filenames 1687 (if bookmark-bmenu-toggle-filenames
1689 (goto-char (point-min)) 1728 (goto-char (point-min))
1690 (pop-to-buffer old-buf))) 1729 (pop-to-buffer old-buf)))
1691 1730
1692 1731
1693 (defun bookmark-bmenu-mark () 1732 (defun bookmark-bmenu-mark ()
1694 "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select] command." 1733 "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
1695 (interactive) 1734 (interactive)
1696 (beginning-of-line) 1735 (beginning-of-line)
1697 (if (bookmark-bmenu-check-position) 1736 (if (bookmark-bmenu-check-position)
1698 (let ((buffer-read-only nil)) 1737 (let ((buffer-read-only nil))
1699 (delete-char 1) 1738 (delete-char 1)
1816 (goto-char pos) 1855 (goto-char pos)
1817 (set-window-point (get-buffer-window buff) pos) 1856 (set-window-point (get-buffer-window buff) pos)
1818 (set-buffer o-buffer)) 1857 (set-buffer o-buffer))
1819 (bookmark-show-annotation bookmark))))) 1858 (bookmark-show-annotation bookmark)))))
1820 1859
1860 (defun bookmark-bmenu-other-window-with-mouse (event)
1861 "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
1862 (interactive "e")
1863 (save-excursion
1864 (set-buffer (if (fboundp 'event-buffer) ; XEmacs
1865 (event-buffer event)
1866 (window-buffer (posn-window (event-end event)))))
1867 (save-excursion
1868 (goto-char (if (fboundp 'event-closest-point)
1869 (event-closest-point event)
1870 (posn-point (event-end event))))
1871 (bookmark-bmenu-other-window))))
1872
1821 1873
1822 (defun bookmark-bmenu-show-annotation () 1874 (defun bookmark-bmenu-show-annotation ()
1823 "Show the annotation for the current bookmark in another window." 1875 "Show the annotation for the current bookmark in another window."
1824 (interactive) 1876 (interactive)
1825 (let ((bookmark (bookmark-bmenu-bookmark))) 1877 (let ((bookmark (bookmark-bmenu-bookmark)))
1874 (bookmark-bmenu-unmark) 1926 (bookmark-bmenu-unmark)
1875 (forward-line -1)))) 1927 (forward-line -1))))
1876 1928
1877 1929
1878 (defun bookmark-bmenu-delete () 1930 (defun bookmark-bmenu-delete ()
1879 "Mark bookmark on this line to be deleted by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions] command." 1931 "Mark bookmark on this line to be deleted.
1932 To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
1880 (interactive) 1933 (interactive)
1881 (beginning-of-line) 1934 (beginning-of-line)
1882 (if (bookmark-bmenu-check-position) 1935 (if (bookmark-bmenu-check-position)
1883 (let ((buffer-read-only nil)) 1936 (let ((buffer-read-only nil))
1884 (delete-char 1) 1937 (delete-char 1)
1885 (insert ?D) 1938 (insert ?D)
1886 (forward-line 1)))) 1939 (forward-line 1))))
1887 1940
1888 1941
1889 (defun bookmark-bmenu-delete-backwards () 1942 (defun bookmark-bmenu-delete-backwards ()
1890 "Mark bookmark on this line to be deleted by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions] command 1943 "Mark bookmark on this line to be deleted, then move up one line.
1891 and then move up one line" 1944 To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
1892 (interactive) 1945 (interactive)
1893 (bookmark-bmenu-delete) 1946 (bookmark-bmenu-delete)
1894 (forward-line -2) 1947 (forward-line -2)
1895 (if (bookmark-bmenu-check-position) 1948 (if (bookmark-bmenu-check-position)
1896 (forward-line 1))) 1949 (forward-line 1)))
1897 1950
1898 1951
1899 (defun bookmark-bmenu-execute-deletions () 1952 (defun bookmark-bmenu-execute-deletions ()
1900 "Delete bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands." 1953 "Delete bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
1901 (interactive) 1954 (interactive)
1955 (message "Deleting bookmarks...")
1902 (let ((hide-em bookmark-bmenu-toggle-filenames) 1956 (let ((hide-em bookmark-bmenu-toggle-filenames)
1903 (o-point (point)) 1957 (o-point (point))
1904 (o-str (save-excursion 1958 (o-str (save-excursion
1905 (beginning-of-line) 1959 (beginning-of-line)
1906 (if (looking-at "^D") 1960 (if (looking-at "^D")
1928 (goto-char o-point)) 1982 (goto-char o-point))
1929 (beginning-of-line) 1983 (beginning-of-line)
1930 (setq bookmark-alist-modification-count 1984 (setq bookmark-alist-modification-count
1931 (1+ bookmark-alist-modification-count)) 1985 (1+ bookmark-alist-modification-count))
1932 (if (bookmark-time-to-save-p) 1986 (if (bookmark-time-to-save-p)
1933 (bookmark-save)))) 1987 (bookmark-save))
1988 (message "Deleting bookmarks...done")
1989 ))
1934 1990
1935 1991
1936 (defun bookmark-bmenu-rename () 1992 (defun bookmark-bmenu-rename ()
1937 "Rename bookmark on current line. Prompts for a new name." 1993 "Rename bookmark on current line. Prompts for a new name."
1938 (interactive) 1994 (interactive)
2024 "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES. 2080 "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
2025 That is, ENTRIES is a list of strings which appear as the choices 2081 That is, ENTRIES is a list of strings which appear as the choices
2026 in the menu. 2082 in the menu.
2027 The number of panes depends on the number of entries." 2083 The number of panes depends on the number of entries."
2028 (interactive "e") 2084 (interactive "e")
2029 (x-popup-menu event (bookmark-menu-build-paned-menu name entries))) 2085 (cond ((fboundp 'x-popup-menu) ; Emacs
2086 (x-popup-menu event (bookmark-menu-build-paned-menu name entries)))
2087 (t ; XEmacs
2088 (get-popup-menu-response
2089 (cons title
2090 (mapcar
2091 (function
2092 (lambda (x)
2093 (if (stringp x)
2094 (vector x nil nil)
2095 (vector (car x) (list (car x)) t))))
2096 (bookmark-menu-build-paned-menu name entries)))))))
2097
2030 2098
2031 2099
2032 (defun bookmark-menu-popup-paned-bookmark-menu (event name) 2100 (defun bookmark-menu-popup-paned-bookmark-menu (event name)
2033 "Pop up menu of bookmarks, return chosen bookmark. 2101 "Pop up menu of bookmarks, return chosen bookmark.
2034 Pop up at EVENT, menu's name is NAME. 2102 Pop up at EVENT, menu's name is NAME.
2037 2105
2038 2106
2039 (defun bookmark-popup-menu-and-apply-function (func-sym menu-label event) 2107 (defun bookmark-popup-menu-and-apply-function (func-sym menu-label event)
2040 ;; help function for making menus that need to apply a bookmark 2108 ;; help function for making menus that need to apply a bookmark
2041 ;; function to a string. 2109 ;; function to a string.
2042 (if bookmark-xemacsp 2110 (let* ((choice (bookmark-menu-popup-paned-bookmark-menu
2043 (popup-menu (bookmark-build-xemacs-menu 2111 event menu-label)))
2044 menu-label (bookmark-all-names) func-sym)) 2112 (if choice (apply func-sym (list choice)))))
2045 (let* ((choice (bookmark-menu-popup-paned-bookmark-menu
2046 event menu-label)))
2047 (if choice (apply func-sym (list choice))))))
2048 2113
2049 2114
2050 ;;;###autoload 2115 ;;;###autoload
2051 (defun bookmark-menu-insert (event) 2116 (defun bookmark-menu-insert (event)
2052 "Insert the text of the file pointed to by bookmark BOOKMARK. 2117 "Insert the text of the file pointed to by bookmark BOOKMARK.
2134 ;; following works, and for explaining what to do to make it work. 2199 ;; following works, and for explaining what to do to make it work.
2135 2200
2136 ;; We MUST autoload EACH form used to set up this variable's value, so 2201 ;; We MUST autoload EACH form used to set up this variable's value, so
2137 ;; that the whole job is done in loaddefs.el. 2202 ;; that the whole job is done in loaddefs.el.
2138 2203
2139 ;; a pox on autoloading this form. It's too big. --ben 2204 ;; Emacs menubar stuff.
2140 ;(if (string-match "\\(Lucid\\|XEmacs\\)" emacs-version) 2205
2141 ; (progn 2206 ;;;###autoload
2142 ; (defvar bookmark-xemacs-menu 2207 (defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions"))
2143 ; '("Bookmarks" 2208
2144 ; ["Jump to bookmark" bookmark-menu-jump t] 2209 ;;;###autoload
2145 ; ["Set bookmark" bookmark-set t] 2210 (defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map))
2146 ; "---" 2211
2147 ; ["Insert contents" bookmark-menu-insert t] 2212 ;; make bookmarks appear toward the right side of the menu.
2148 ; ["Insert location" bookmark-menu-locate t] 2213 (if (boundp 'menu-bar-final-items)
2149 ; "---" 2214 (if menu-bar-final-items
2150 ; ["Rename bookmark" bookmark-menu-rename t] 2215 (setq menu-bar-final-items
2151 ; ["Delete bookmark" bookmark-menu-delete t] 2216 (cons 'bookmark menu-bar-final-items)))
2152 ; ["Edit Bookmark List" bookmark-bmenu-list t] 2217 (setq menu-bar-final-items '(bookmark)))
2153 ; "---" 2218
2154 ; ["Save bookmarks" bookmark-save t] 2219 ;;;###autoload
2155 ; ["Save bookmarks as..." bookmark-write t] 2220 (define-key menu-bar-bookmark-map [load]
2156 ; ["Load a bookmark file" bookmark-load t])) 2221 '("Load a Bookmark File..." . bookmark-load))
2157 ; ;; Display a solid horizontal line 2222
2158 ; ;;(add-menu-button '("File") ["---" nil nil] "Insert File...") 2223 ;;;###autoload
2159 ; ;;(add-submenu '("File") bookmark-xemacs-menu "Insert File...") 2224 (define-key menu-bar-bookmark-map [write]
2160 ; (add-hook 'before-init-hook 2225 '("Save Bookmarks As..." . bookmark-write))
2161 ; (lambda () 2226
2162 ; (if (featurep 'menubar) 2227 ;;;###autoload
2163 ; (add-submenu '("Edit") bookmark-xemacs-menu 2228 (define-key menu-bar-bookmark-map [save]
2164 ; "Goto Line...")))) 2229 '("Save Bookmarks" . bookmark-save))
2165 ; ) 2230
2166 2231 ;;;###autoload
2167 ; ;; Emacs menubar stuff 2232 (define-key menu-bar-bookmark-map [edit]
2168 ; (defvar menu-bar-bookmark-map (make-sparse-keymap "Bookmark functions")) 2233 '("Edit Bookmark List" . bookmark-bmenu-list))
2169 ; (defalias 'menu-bar-bookmark-map (symbol-value 'menu-bar-bookmark-map)) 2234
2170 2235 ;;;###autoload
2171 ; ;; make bookmarks appear toward the right side of the menu. 2236 (define-key menu-bar-bookmark-map [delete]
2172 ; (if (boundp 'menu-bar-final-items) 2237 '("Delete Bookmark" . bookmark-menu-delete))
2173 ; (if menu-bar-final-items 2238
2174 ; (setq menu-bar-final-items 2239 ;;;###autoload
2175 ; (cons 'bookmark menu-bar-final-items))) 2240 (define-key menu-bar-bookmark-map [rename]
2176 ; (setq menu-bar-final-items '(bookmark))) 2241 '("Rename Bookmark" . bookmark-menu-rename))
2177 2242
2178 ; (define-key menu-bar-bookmark-map [load] 2243 ;;;###autoload
2179 ; '("Load a bookmark file" . bookmark-load)) 2244 (define-key menu-bar-bookmark-map [locate]
2180 ; (define-key menu-bar-bookmark-map [write] 2245 '("Insert Location" . bookmark-menu-locate))
2181 ; '("Save bookmarks as..." . bookmark-write)) 2246
2182 ; (define-key menu-bar-bookmark-map [save] 2247 ;;;###autoload
2183 ; '("Save bookmarks" . bookmark-save)) 2248 (define-key menu-bar-bookmark-map [insert]
2184 ; (define-key menu-bar-bookmark-map [edit] 2249 '("Insert Contents" . bookmark-menu-insert))
2185 ; '("Edit Bookmark List" . bookmark-bmenu-list)) 2250
2186 ; (define-key menu-bar-bookmark-map [delete] 2251 ;;;###autoload
2187 ; '("Delete bookmark" . bookmark-menu-delete)) 2252 (define-key menu-bar-bookmark-map [set]
2188 ; (define-key menu-bar-bookmark-map [rename] 2253 '("Set Bookmark" . bookmark-set))
2189 ; '("Rename bookmark" . bookmark-menu-rename)) 2254
2190 ; (define-key menu-bar-bookmark-map [locate] 2255 ;;;###autoload
2191 ; '("Insert location" . bookmark-menu-locate)) 2256 (define-key menu-bar-bookmark-map [jump]
2192 ; (define-key menu-bar-bookmark-map [insert] 2257 '("Jump to Bookmark" . bookmark-menu-jump))
2193 ; '("Insert contents" . bookmark-menu-insert))
2194 ; (define-key menu-bar-bookmark-map [set]
2195 ; '("Set bookmark" . bookmark-set))
2196 ; (define-key menu-bar-bookmark-map [jump]
2197 ; '("Jump to bookmark" . bookmark-menu-jump)))
2198
2199 2258
2200 ;;;; end bookmark menu stuff ;;;; 2259 ;;;; end bookmark menu stuff ;;;;
2201 2260
2202 2261
2203 ;;; Load Hook 2262 ;;; Load Hook