bookmark.el 80.8 KB
Newer Older
1
;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
Richard M. Stallman's avatar
Richard M. Stallman committed
2

3
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2004, 2005, 2006, 2007, 2008, 2009 Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
5

6 7
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
Richard M. Stallman's avatar
Richard M. Stallman committed
8
;; Created: July, 1993
9
;; Keywords: bookmarks, placeholders, annotations
Richard M. Stallman's avatar
Richard M. Stallman committed
10 11 12

;; This file is part of GNU Emacs.

13
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
14
;; it under the terms of the GNU General Public License as published by
15 16
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
Richard M. Stallman's avatar
Richard M. Stallman committed
17 18 19 20 21 22 23

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
24
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Erik Naggum's avatar
Erik Naggum committed
25 26 27 28 29 30 31

;;; Commentary:

;; This package is for setting "bookmarks" in files.  A bookmark
;; associates a string with a location in a certain file.  Thus, you
;; can navigate your way to that location by providing the string.
;; See the "User Variables" section for customizations.
Richard M. Stallman's avatar
Richard M. Stallman committed
32 33 34

;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and
;; then implementing the bookmark-current-bookmark idea.  He even
Karl Fogel's avatar
Karl Fogel committed
35
;; sent *patches*, bless his soul...
Richard M. Stallman's avatar
Richard M. Stallman committed
36 37 38 39

;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for
;; fixing and improving bookmark-time-to-save-p.

40 41
;; Thanks go to Andrew V. Klein <avk@cig.mot.com> for the code that
;; sorts the alist before presenting it to the user (in bookmark-bmenu-list
Karl Fogel's avatar
Karl Fogel committed
42 43
;; and the menu-bar).

44 45
;; And much thanks to David Hughes <djh@harston.cv.com> for many small
;; suggestions and the code to implement them (like
46
;; bookmark-bmenu-check-position, and some of the Lucid compatibility
47 48
;; stuff).

49
;; Kudos (whatever they are) go to Jim Blandy <jimb@red-bean.com>
Karl Fogel's avatar
Karl Fogel committed
50 51 52 53
;; for his eminently sensible suggestion to separate bookmark-jump
;; into bookmark-jump and bookmark-jump-noselect, which made many
;; other things cleaner as well.

54 55 56
;; Thanks to Roland McGrath for encouragement and help with defining
;; autoloads on the menu-bar.

Karl Heuer's avatar
Karl Heuer committed
57
;; Jonathan Stigelman <stig@hackvan.com> gave patches for default
Karl Fogel's avatar
Karl Fogel committed
58 59 60 61
;; values in bookmark-jump and bookmark-set.  Everybody please keep
;; all the keystrokes they save thereby and send them to him at the
;; end of each year :-)  (No, seriously, thanks Jonathan!)

62 63 64
;; Buckets of gratitude to John Grabowski <johng@media.mit.edu> for
;; thinking up the annotations feature and implementing it so well.

Richard M. Stallman's avatar
Richard M. Stallman committed
65 66 67
;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad
;; <olstad@msc.edu>.

68 69 70
;; Thanks to Mikio Nakajima <PBC01764@niftyserve.or.jp> for many bugs
;; reported and fixed.

71 72
;; Thank you, Michael Kifer, for contributing the XEmacs support.

73
;; Enough with the credits already, get on to the good stuff:
Richard M. Stallman's avatar
Richard M. Stallman committed
74

Sam Steingold's avatar
Sam Steingold committed
75
;; FAVORITE CHINESE RESTAURANT:
Richard M. Stallman's avatar
Richard M. Stallman committed
76 77
;; Boy, that's a tough one.  Probably Hong Min, or maybe Emperor's
;; Choice (both in Chicago's Chinatown).  Well, both.  How about you?
78

79
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
80

Erik Naggum's avatar
Erik Naggum committed
81
(require 'pp)
82
(eval-when-compile (require 'cl))
Erik Naggum's avatar
Erik Naggum committed
83

84
;;; Misc comments:
Richard M. Stallman's avatar
Richard M. Stallman committed
85
;;
86
;; If variable bookmark-use-annotations is non-nil, an annotation is
Sam Steingold's avatar
Sam Steingold committed
87
;; queried for when setting a bookmark.
Richard M. Stallman's avatar
Richard M. Stallman committed
88
;;
89 90 91 92
;; The bookmark list is sorted lexically by default, but you can turn
;; this off by setting bookmark-sort-flag to nil.  If it is nil, then
;; the list will be presented in the order it is recorded
;; (chronologically), which is actually fairly useful as well.
Richard M. Stallman's avatar
Richard M. Stallman committed
93

94 95
;;; User Variables

96
(defgroup bookmark nil
97
  "Setting, annotation and jumping to bookmarks."
98 99 100 101
  :group 'matching)


(defcustom bookmark-use-annotations nil
Stefan Monnier's avatar
Stefan Monnier committed
102
  "If non-nil, saving a bookmark queries for an annotation in a buffer."
103 104
  :type 'boolean
  :group 'bookmark)
105 106


107
(defcustom bookmark-save-flag t
Stefan Monnier's avatar
Stefan Monnier committed
108
  "Controls when Emacs saves bookmarks to a file.
109
--> nil means never save bookmarks, except when `bookmark-save' is
110 111
    explicitly called \(\\[bookmark-save]\).
--> t means save bookmarks when Emacs is killed.
112
--> Otherwise, it should be a number that is the frequency with which
113 114 115 116 117 118 119 120 121 122
    the bookmark list is saved \(i.e.: the number of times which
    Emacs' bookmark list may be modified before it is automatically
    saved.\).  If it is a number, Emacs will also automatically save
    bookmarks when it is killed.

Therefore, the way to get it to save every time you make or delete a
bookmark is to set this variable to 1 \(or 0, which produces the same
behavior.\)

To specify the file in which to save them, modify the variable
123
`bookmark-default-file', which is `~/.emacs.bmk' by default."
124
  :type '(choice (const nil) integer (other t))
125
  :group 'bookmark)
126 127 128


(defconst bookmark-old-default-file "~/.emacs-bkmrks"
Lute Kamstra's avatar
Lute Kamstra committed
129
  "The `.emacs.bmk' file used to be called this name.")
130 131 132 133 134 135


;; defvarred to avoid a compilation warning:
(defvar bookmark-file nil
  "Old name for `bookmark-default-file'.")

136
(defcustom bookmark-default-file
137 138 139
  (if bookmark-file
      ;; In case user set `bookmark-file' in her .emacs:
      bookmark-file
140
    (convert-standard-filename "~/.emacs.bmk"))
Stefan Monnier's avatar
Stefan Monnier committed
141
  "File in which to save bookmarks by default."
142 143
  :type 'file
  :group 'bookmark)
144 145


146
(defcustom bookmark-version-control 'nospecial
Stefan Monnier's avatar
Stefan Monnier committed
147
  "Whether or not to make numbered backups of the bookmark file.
148 149 150
It can have four values: t, nil, `never', and `nospecial'.
The first three have the same meaning that they do for the
variable `version-control', and the final value `nospecial' means just
151
use the value of `version-control'."
152 153
  :type '(choice (const nil) (const never) (const nospecial)
		 (other t))
154
  :group 'bookmark)
155 156


157
(defcustom bookmark-completion-ignore-case t
Stefan Monnier's avatar
Stefan Monnier committed
158
  "Non-nil means bookmark functions ignore case in completion."
159 160
  :type 'boolean
  :group 'bookmark)
161 162


163
(defcustom bookmark-sort-flag t
Stefan Monnier's avatar
Stefan Monnier committed
164
  "Non-nil means that bookmarks will be displayed sorted by bookmark name.
165
Otherwise they will be displayed in LIFO order (that is, most
166 167 168
recently set ones come first, oldest ones come last)."
  :type 'boolean
  :group 'bookmark)
169 170


171
(defcustom bookmark-automatically-show-annotations t
Stefan Monnier's avatar
Stefan Monnier committed
172
  "Non-nil means show annotations when jumping to a bookmark."
173 174
  :type 'boolean
  :group 'bookmark)
175 176


177
(defcustom bookmark-bmenu-file-column 30
Stefan Monnier's avatar
Stefan Monnier committed
178
  "Column at which to display filenames in a buffer listing bookmarks.
179 180 181
You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
  :type 'integer
  :group 'bookmark)
182 183


184
(defcustom bookmark-bmenu-toggle-filenames t
Stefan Monnier's avatar
Stefan Monnier committed
185
  "Non-nil means show filenames when listing bookmarks.
186
This may result in truncated bookmark names.  To disable this, put the
187
following in your `.emacs' file:
188

189 190 191
\(setq bookmark-bmenu-toggle-filenames nil\)"
  :type 'boolean
  :group 'bookmark)
192 193


194
(defcustom bookmark-menu-length 70
Stefan Monnier's avatar
Stefan Monnier committed
195
  "Maximum length of a bookmark name displayed on a popup menu."
196
  :type 'integer
197
  :group 'bookmark)
198 199


200 201 202 203 204 205 206
(defface bookmark-menu-heading
  '((t (:inherit font-lock-type-face)))
  "Face used to highlight the heading in bookmark menu buffers."
  :group 'bookmark
  :version "22.1")


207
;;; No user-serviceable parts beyond this point.
Richard M. Stallman's avatar
Richard M. Stallman committed
208 209 210 211

;; Added  for lucid emacs  compatibility, db
(or (fboundp 'defalias)  (fset 'defalias 'fset))

212
;; suggested for lucid compatibility by david hughes:
213
(or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
214

215 216

;;; Keymap stuff:
Richard M. Stallman's avatar
Richard M. Stallman committed
217

218 219 220
;; Set up these bindings dumping time *only*;
;; if the user alters them, don't override the user when loading bookmark.el.

221 222 223
;;;###autoload (define-key ctl-x-r-map "b" 'bookmark-jump)
;;;###autoload (define-key ctl-x-r-map "m" 'bookmark-set)
;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
224

225
;;;###autoload
226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242
(defvar bookmark-map
  (let ((map (make-sparse-keymap)))
    ;; Read the help on all of these functions for details...
    (define-key map "x" 'bookmark-set)
    (define-key map "m" 'bookmark-set) ;"m"ark
    (define-key map "j" 'bookmark-jump)
    (define-key map "g" 'bookmark-jump) ;"g"o
    (define-key map "o" 'bookmark-jump-other-window)
    (define-key map "i" 'bookmark-insert)
    (define-key map "e" 'edit-bookmarks)
    (define-key map "f" 'bookmark-insert-location) ;"f"ind
    (define-key map "r" 'bookmark-rename)
    (define-key map "d" 'bookmark-delete)
    (define-key map "l" 'bookmark-load)
    (define-key map "w" 'bookmark-write)
    (define-key map "s" 'bookmark-save)
    map)
Richard M. Stallman's avatar
Richard M. Stallman committed
243 244 245 246
  "Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
key of your choice to `bookmark-map'.  All interactive bookmark
Richard M. Stallman's avatar
Richard M. Stallman committed
247 248
functions have a binding in this keymap.")

249
;;;###autoload (fset 'bookmark-map bookmark-map)
250 251 252


;;; Core variables and data structures:
253
(defvar bookmark-alist ()
254
  "Association list of bookmarks and their records.
255
You probably don't want to change the value of this alist yourself;
256 257 258 259 260 261
instead, let the various bookmark functions do it for you.

The format of the alist is

       \(BOOKMARK1 BOOKMARK2 ...\)

262
where each BOOKMARK is of the form
263

264
  (NAME PARAM-ALIST) or (NAME . PARAM-ALIST)
265

266 267 268 269 270 271 272
where the first form is the old deprecated one and the second is
the new favored one.  PARAM-ALIST is typically of the form:

 ((filename . FILE)
  (front-context-string . FRONT-STR)
  (rear-context-string  . REAR-STR)
  (position . POS)
273 274 275 276 277 278
  (handler . HANDLER-FUNC)
  (annotation . ANNOTATION))

If the element `(handler . HANDLER-FUNC)' is present, HANDLER-FUNC
will be used to open this bookmark instead of `bookmark-default-handler',
whose calling discipline HANDLER-FUNC should of course match.")
279

280

Karl Fogel's avatar
Karl Fogel committed
281 282
(defvar bookmarks-already-loaded nil
  "Non-nil iff bookmarks have been loaded from `bookmark-default-file'.")
283

284

Richard M. Stallman's avatar
Richard M. Stallman committed
285
;; more stuff added by db.
286

Sam Steingold's avatar
Sam Steingold committed
287
(defvar bookmark-current-bookmark nil
Richard M. Stallman's avatar
Richard M. Stallman committed
288 289
  "Name of bookmark most recently used in the current file.
It is buffer local, used to make moving a bookmark forward
Richard M. Stallman's avatar
Richard M. Stallman committed
290
through a file easier.")
Richard M. Stallman's avatar
Richard M. Stallman committed
291 292 293

(make-variable-buffer-local 'bookmark-current-bookmark)

294

Richard M. Stallman's avatar
Richard M. Stallman committed
295
(defvar bookmark-alist-modification-count 0
Richard M. Stallman's avatar
Richard M. Stallman committed
296
  "Number of modifications to bookmark list since it was last saved.")
Richard M. Stallman's avatar
Richard M. Stallman committed
297

298 299

(defvar bookmark-search-size 16
Richard M. Stallman's avatar
Richard M. Stallman committed
300
  "Length of the context strings recorded on either side of a bookmark.")
Richard M. Stallman's avatar
Richard M. Stallman committed
301

302

Karl Fogel's avatar
Karl Fogel committed
303 304 305 306 307 308 309 310 311 312 313
(defvar bookmark-current-buffer nil
  "The buffer in which a bookmark is currently being set or renamed.
Functions that insert strings into the minibuffer use this to know
the source buffer for that information; see `bookmark-yank-word' and
`bookmark-insert-current-bookmark' for example.")


(defvar bookmark-yank-point 0
  "The next point from which to pull source text for `bookmark-yank-word'.
This point is in `bookmark-curent-buffer'.")

Richard M. Stallman's avatar
Richard M. Stallman committed
314

315 316 317 318 319 320 321

;; Helper functions.

;; Only functions on this page and the next one (file formats) need to
;; know anything about the format of bookmark-alist entries.
;; Everyone else should go through them.

322

323
(defun bookmark-name-from-full-record (full-record)
324
  "Return name of FULL-RECORD \(an alist element instead of a string\)."
325 326 327 328 329 330
  (car full-record))


(defun bookmark-all-names ()
  "Return a list of all current bookmark names."
  (bookmark-maybe-load-default-file)
331
  (mapcar 'bookmark-name-from-full-record bookmark-alist))
332 333


334
(defun bookmark-get-bookmark (bookmark &optional noerror)
335
  "Return the bookmark record corresponding to BOOKMARK.
Karl Fogel's avatar
Karl Fogel committed
336 337 338
If BOOKMARK is a string, look for the corresponding bookmark record in
`bookmark-alist'; return it if found, otherwise error.  Else if
BOOKMARK is already a bookmark record, just return it."
339 340 341
  (cond
   ((consp bookmark) bookmark)
   ((stringp bookmark)
342 343
    (or (assoc-string bookmark bookmark-alist bookmark-completion-ignore-case)
        (unless noerror (error "Invalid bookmark %s" bookmark))))))
344 345 346


(defun bookmark-get-bookmark-record (bookmark)
Karl Fogel's avatar
Karl Fogel committed
347 348 349
  "Return the record portion of the entry for BOOKMARK in
`bookmark-alist' (that is, all information but the name).
BOOKMARK may be a bookmark name (a string) or a bookmark record."
350
  (let ((alist (cdr (bookmark-get-bookmark bookmark))))
351 352 353 354
    ;; The bookmark objects can either look like (NAME ALIST) or
    ;; (NAME . ALIST), so we have to distinguish the two here.
    (if (and (null (cdr alist)) (consp (caar alist)))
        (car alist) alist)))
355 356 357


(defun bookmark-set-name (bookmark newname)
Karl Fogel's avatar
Karl Fogel committed
358 359
  "Set BOOKMARK's name to NEWNAME.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
360 361 362
  (setcar
   (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
   newname))
363

364
(defun bookmark-prop-get (bookmark prop)
Karl Fogel's avatar
Karl Fogel committed
365 366
  "Return the property PROP of BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
367 368 369
  (cdr (assq prop (bookmark-get-bookmark-record bookmark))))

(defun bookmark-prop-set (bookmark prop val)
Karl Fogel's avatar
Karl Fogel committed
370 371
  "Set the property PROP of BOOKMARK to VAL.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
372 373 374 375 376
  (let ((cell (assq prop (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell val)
      (nconc (bookmark-get-bookmark-record bookmark)
             (list (cons prop val))))))
377 378

(defun bookmark-get-annotation (bookmark)
Karl Fogel's avatar
Karl Fogel committed
379 380
  "Return the annotation of BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
381
  (bookmark-prop-get bookmark 'annotation))
382 383

(defun bookmark-set-annotation (bookmark ann)
Karl Fogel's avatar
Karl Fogel committed
384 385
  "Set the annotation of BOOKMARK to ANN.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
386
  (bookmark-prop-set bookmark 'annotation ann))
387 388 389


(defun bookmark-get-filename (bookmark)
Karl Fogel's avatar
Karl Fogel committed
390 391
  "Return the full filename of BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
392
  (bookmark-prop-get bookmark 'filename))
393 394 395


(defun bookmark-set-filename (bookmark filename)
Karl Fogel's avatar
Karl Fogel committed
396 397
  "Set the full filename of BOOKMARK to FILENAME.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
398
  (bookmark-prop-set bookmark 'filename filename))
399 400 401


(defun bookmark-get-position (bookmark)
Karl Fogel's avatar
Karl Fogel committed
402 403
  "Return the position \(i.e.: point\) of BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
404
  (bookmark-prop-get bookmark 'position))
405 406 407


(defun bookmark-set-position (bookmark position)
Karl Fogel's avatar
Karl Fogel committed
408 409
  "Set the position \(i.e.: point\) of BOOKMARK to POSITION.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
410
  (bookmark-prop-set bookmark 'position position))
411 412 413


(defun bookmark-get-front-context-string (bookmark)
Karl Fogel's avatar
Karl Fogel committed
414 415
  "Return the front-context-string of BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
416
  (bookmark-prop-get bookmark 'front-context-string))
417 418 419


(defun bookmark-set-front-context-string (bookmark string)
Karl Fogel's avatar
Karl Fogel committed
420 421
  "Set the front-context-string of BOOKMARK to STRING.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
422
  (bookmark-prop-set bookmark 'front-context-string string))
423 424 425


(defun bookmark-get-rear-context-string (bookmark)
Karl Fogel's avatar
Karl Fogel committed
426 427
  "Return the rear-context-string of BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
428
  (bookmark-prop-get bookmark 'rear-context-string))
429 430 431


(defun bookmark-set-rear-context-string (bookmark string)
Karl Fogel's avatar
Karl Fogel committed
432 433
  "Set the rear-context-string of BOOKMARK to STRING.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
434
  (bookmark-prop-set bookmark 'rear-context-string string))
435 436


437
(defun bookmark-get-handler (bookmark)
Karl Fogel's avatar
Karl Fogel committed
438 439
  "Return the handler function for BOOKMARK, or nil if none.
BOOKMARK may be a bookmark name (a string) or a bookmark record."
440
  (bookmark-prop-get bookmark 'handler))
441

442 443 444 445
(defvar bookmark-history nil
  "The history list for bookmark functions.")


446 447 448 449 450 451 452
(defun bookmark-completing-read (prompt &optional default)
  "Prompting with PROMPT, read a bookmark name in completion.
PROMPT will get a \": \" stuck on the end no matter what, so you
probably don't want to include one yourself.
Optional second arg DEFAULT is a string to return if the user enters
the empty string."
  (bookmark-maybe-load-default-file) ; paranoia
453 454 455 456 457 458 459 460 461 462 463 464 465 466 467
  (if (listp last-nonmenu-event)
      (bookmark-menu-popup-paned-menu t prompt (bookmark-all-names))
    (let* ((completion-ignore-case bookmark-completion-ignore-case)
	   (default default)
	   (prompt (if default
		       (concat prompt (format " (%s): " default))
		     (concat prompt ": ")))
	   (str
	    (completing-read prompt
			     bookmark-alist
			     nil
			     0
			     nil
			     'bookmark-history)))
      (if (string-equal "" str) default str))))
468 469


470 471 472 473
(defmacro bookmark-maybe-historicize-string (string)
  "Put STRING into the bookmark prompt history, if caller non-interactive.
We need this because sometimes bookmark functions are invoked from
menus, so `completing-read' never gets a chance to set `bookmark-history'."
Sam Steingold's avatar
Sam Steingold committed
474
  `(or
475
    (called-interactively-p 'interactive)
Sam Steingold's avatar
Sam Steingold committed
476
    (setq bookmark-history (cons ,string bookmark-history))))
477

478
(defvar bookmark-make-record-function 'bookmark-make-record-default
479 480 481 482
  "A function that should be called to create a bookmark record.
Modes may set this variable buffer-locally to enable bookmarking of
locations that should be treated specially, such as Info nodes,
news posts, images, pdf documents, etc.
483

484
The function will be called with no arguments.
485 486
It should signal a user error if it is unable to construct a record for
the current location.
487 488 489

The returned record should be a cons cell of the form (NAME . ALIST)
where ALIST is as described in `bookmark-alist' and may typically contain
490 491 492
a special cons (handler . HANDLER-FUNC) which specifies the handler function
that should be used instead of `bookmark-default-handler' to open this
bookmark.  See the documentation for `bookmark-alist' for more.
493 494

NAME is a suggested name for the constructed bookmark.  It can be nil
495 496
in which case a default heuristic will be used.  The function can also
equivalently just return ALIST without NAME.")
497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513

(defun bookmark-make-record ()
  "Return a new bookmark record (NAME . ALIST) for the current location."
  (let ((record (funcall bookmark-make-record-function)))
    ;; Set up default name.
    (if (stringp (car record))
        ;; The function already provided a default name.
        record
      (if (car record) (push nil record))
      (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))
      record)))

(defun bookmark-store (name alist no-overwrite)
  "Store the bookmark NAME with data ALIST.
If NO-OVERWRITE is non-nil and another bookmark of the same name already
exists in `bookmark-alist', record the new bookmark without throwing away the
old one."
514
  (bookmark-maybe-load-default-file)
515
  (let ((stripped-name (copy-sequence name)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
516
    (or (featurep 'xemacs)
517 518 519
        ;; XEmacs's `set-text-properties' doesn't work on
        ;; free-standing strings, apparently.
        (set-text-properties 0 (length stripped-name) nil stripped-name))
520 521
    (if (and (not no-overwrite)
             (bookmark-get-bookmark stripped-name 'noerror))
522
        ;; already existing bookmark under that name and
523
        ;; no prefix arg means just overwrite old bookmark
524 525
        ;; Use the new (NAME . ALIST) format.
        (setcdr (bookmark-get-bookmark stripped-name) alist)
Sam Steingold's avatar
Sam Steingold committed
526

527 528 529
      ;; otherwise just cons it onto the front (either the bookmark
      ;; doesn't exist already, or there is no prefix arg.  In either
      ;; case, we want the new bookmark consed onto the alist...)
Sam Steingold's avatar
Sam Steingold committed
530

531
      (push (cons stripped-name alist) bookmark-alist))
Sam Steingold's avatar
Sam Steingold committed
532

533 534 535 536 537
    ;; Added by db
    (setq bookmark-current-bookmark stripped-name)
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
    (if (bookmark-time-to-save-p)
538
        (bookmark-save))
539

540 541
    (setq bookmark-current-bookmark stripped-name)
    (bookmark-bmenu-surreptitiously-rebuild-list)))
542

543
(defun bookmark-make-record-default (&optional point-only)
544
  "Return the record describing the location of a new bookmark.
545
Must be at the correct position in the buffer in which the bookmark is
546 547 548 549
being set.
If POINT-ONLY is non-nil, then only return the subset of the
record that pertains to the location within the buffer."
  `(,@(unless point-only `((filename . ,(bookmark-buffer-file-name))))
550 551 552 553 554 555 556 557 558 559 560 561 562
    (front-context-string
     . ,(if (>= (- (point-max) (point)) bookmark-search-size)
            (buffer-substring-no-properties
             (point)
             (+ (point) bookmark-search-size))
          nil))
    (rear-context-string
     . ,(if (>= (- (point) (point-min)) bookmark-search-size)
            (buffer-substring-no-properties
             (point)
             (- (point) bookmark-search-size))
          nil))
    (position . ,(point))))
Sam Steingold's avatar
Sam Steingold committed
563

564 565 566 567 568

;;; File format stuff

;; The OLD format of the bookmark-alist was:
;;
569 570 571 572
;;       ((BOOKMARK-NAME . (FILENAME
;;                          STRING-IN-FRONT
;;                          STRING-BEHIND
;;                          POINT))
573 574 575 576
;;        ...)
;;
;; The NEW format of the bookmark-alist is:
;;
577 578 579 580 581 582 583 584
;;       ((BOOKMARK-NAME (filename   . FILENAME)
;;                       (front-context-string . STRING-IN-FRONT)
;;                       (rear-context-string  . STRING-BEHIND)
;;                       (position   . POINT)
;;                       (annotation . ANNOTATION)
;;                       (whatever   . VALUE)
;;                       ...
;;                       ))
585 586 587 588 589 590 591 592 593 594
;;        ...)
;;
;;
;; I switched to using an internal as well as external alist because I
;; felt that would be a more flexible framework in which to add
;; features.  It means that the order in which values appear doesn't
;; matter, and it means that arbitrary values can be added without
;; risk of interfering with existing ones.
;;
;; BOOKMARK-NAME is the string the user gives the bookmark and
Sam Steingold's avatar
Sam Steingold committed
595
;; accesses it by from then on.
596 597 598 599 600 601
;;
;; FILENAME is the location of the file in which the bookmark is set.
;;
;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
;; context in front of the point at which the bookmark is set.
;;
Sam Steingold's avatar
Sam Steingold committed
602
;; STRING-BEHIND is the same thing, but after the point.
603 604
;;
;; The context strings exist so that modifications to a file don't
Sam Steingold's avatar
Sam Steingold committed
605
;; necessarily cause a bookmark's position to be invalidated.
606 607 608
;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
;; case the file has changed since the bookmark was set.  It will
;; attempt to place the user before the changes, if there were any.
609
;; ANNOTATION is the annotation for the bookmark; it may not exist
610 611 612 613 614 615 616 617 618 619 620 621 622 623 624
;; (for backward compatibility), be nil (no annotation), or be a
;; string.


(defconst bookmark-file-format-version 1
  "The current version of the format used by bookmark files.
You should never need to change this.")


(defconst bookmark-end-of-version-stamp-marker
  "-*- End Of Bookmark File Format Version Stamp -*-\n"
  "This string marks the end of the version stamp in a bookmark file.")


(defun bookmark-alist-from-buffer ()
625
  "Return a `bookmark-alist' (in any format) from the current buffer.
626 627 628 629 630 631 632 633 634 635 636 637 638
The buffer must of course contain bookmark format information.
Does not care from where in the buffer it is called, and does not
affect point."
  (save-excursion
    (goto-char (point-min))
    (if (search-forward bookmark-end-of-version-stamp-marker nil t)
        (read (current-buffer))
      ;; Else we're dealing with format version 0
      (if (search-forward "(" nil t)
          (progn
            (forward-char -1)
            (read (current-buffer)))
        ;; Else no hope of getting information here.
639
        (error "Not bookmark format")))))
640 641 642


(defun bookmark-upgrade-version-0-alist (old-list)
643
  "Upgrade a version 0 alist OLD-LIST to the current version."
644 645 646 647 648 649 650 651 652 653 654
  (mapcar
   (lambda (bookmark)
     (let* ((name      (car bookmark))
            (record    (car (cdr bookmark)))
            (filename  (nth 0 record))
            (front-str (nth 1 record))
            (rear-str  (nth 2 record))
            (position  (nth 3 record))
            (ann       (nth 4 record)))
       (list
        name
655 656 657 658 659
        `((filename             .    ,filename)
          (front-context-string .    ,(or front-str ""))
          (rear-context-string  .    ,(or rear-str  ""))
          (position             .    ,position)
          (annotation           .    ,ann)))))
660 661 662 663 664
   old-list))


(defun bookmark-upgrade-file-format-from-0 ()
  "Upgrade a bookmark file of format 0 (the original format) to format 1.
665
This expects to be called from `point-min' in a bookmark file."
666 667 668 669 670 671 672 673 674
  (message "Upgrading bookmark format from 0 to %d..."
           bookmark-file-format-version)
  (let* ((old-list (bookmark-alist-from-buffer))
         (new-list (bookmark-upgrade-version-0-alist old-list)))
    (delete-region (point-min) (point-max))
    (bookmark-insert-file-format-version-stamp)
    (pp new-list (current-buffer))
    (save-buffer))
  (goto-char (point-min))
675
  (message "Upgrading bookmark format from 0 to %d...done"
676 677 678 679 680 681
           bookmark-file-format-version)
  )


(defun bookmark-grok-file-format-version ()
  "Return an integer which is the file-format version of this bookmark file.
682
This expects to be called from `point-min' in a bookmark file."
683 684 685 686 687 688 689 690 691 692 693 694 695 696
  (if (looking-at "^;;;;")
      (save-excursion
        (save-match-data
          (re-search-forward "[0-9]")
          (forward-char -1)
          (read (current-buffer))))
    ;; Else this is format version 0, the original one, which didn't
    ;; even have version stamps.
    0))


(defun bookmark-maybe-upgrade-file-format ()
  "Check the file-format version of this bookmark file.
If the version is not up-to-date, upgrade it automatically.
697
This expects to be called from `point-min' in a bookmark file."
698 699 700 701 702 703 704
  (let ((version (bookmark-grok-file-format-version)))
    (cond
     ((= version bookmark-file-format-version)
      ) ; home free -- version is current
     ((= version 0)
      (bookmark-upgrade-file-format-from-0))
     (t
705
      (error "Bookmark file format version strangeness")))))
706 707 708


(defun bookmark-insert-file-format-version-stamp ()
709
  "Insert text indicating current version of bookmark file format."
710 711 712 713 714 715 716 717 718 719 720
  (insert
   (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
           bookmark-file-format-version))
  (insert ";;; This format is meant to be slightly human-readable;\n"
          ";;; nevertheless, you probably don't want to edit it.\n"
          ";;; "
          bookmark-end-of-version-stamp-marker))


;;; end file-format stuff

721 722 723 724 725 726 727 728

;;; Generic helpers.

(defun bookmark-maybe-message (fmt &rest args)
  "Apply `message' to FMT and ARGS, but only if the display is fast enough."
  (if (>= baud-rate 9600)
      (apply 'message fmt args)))

729 730 731

;;; Core code:

Stefan Monnier's avatar
Stefan Monnier committed
732 733 734 735 736 737 738 739 740 741
(defvar bookmark-minibuffer-read-name-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map minibuffer-local-map)
    (define-key map "\C-w" 'bookmark-yank-word)
    ;; This C-u binding might not be very useful any more now that we
    ;; provide access to the default via the standard M-n binding.
    ;; Maybe we should just remove it?  --Stef-08
    (define-key map "\C-u" 'bookmark-insert-current-bookmark)
    map))

742
;;;###autoload
Karl Fogel's avatar
Karl Fogel committed
743
(defun bookmark-set (&optional name no-overwrite)
744
  "Set a bookmark named NAME at the current location.
Karl Fogel's avatar
Karl Fogel committed
745 746 747 748
If name is nil, then prompt the user.

With prefix arg (NO-OVERWRITE), do not overwrite a bookmark that
has the same name as NAME if such a bookmark already exists, but
749 750
instead push the new bookmark onto the bookmark alist.  Thus the
most recently set bookmark with name NAME would be the one in
Karl Fogel's avatar
Karl Fogel committed
751 752
effect at any given time, but the others are still there, should
the user decide to delete the most recent one.
Richard M. Stallman's avatar
Richard M. Stallman committed
753 754

To yank words from the text of the buffer and use them as part of the
Richard M. Stallman's avatar
Richard M. Stallman committed
755
bookmark name, type C-w while setting a bookmark.  Successive C-w's
Richard M. Stallman's avatar
Richard M. Stallman committed
756 757
yank successive words.

758 759 760 761 762
Typing C-u will insert (at the bookmark name prompt) the name of the
last bookmark used in the document where the new bookmark is being set;
this helps one use a single bookmark name to track progress through
a large document.  If there is no prior bookmark for this document,
then C-u inserts an appropriate name based on the buffer or file.
Richard M. Stallman's avatar
Richard M. Stallman committed
763

Karl Fogel's avatar
Karl Fogel committed
764 765
Use \\[bookmark-delete] to remove bookmarks \(give it a name and it
removes only the first instance of a bookmark with that name from
Richard M. Stallman's avatar
Richard M. Stallman committed
766
the list of bookmarks.\)"
767
  (interactive (list nil current-prefix-arg))
768 769 770 771 772 773 774 775 776 777 778 779 780 781 782 783
  (let* ((record (bookmark-make-record))
         (default (car record)))

    (bookmark-maybe-load-default-file)

    (setq bookmark-yank-point (point))
    (setq bookmark-current-buffer (current-buffer))

    (let ((str
           (or name
               (read-from-minibuffer
                (format "Set bookmark (%s): " default)
                nil
                bookmark-minibuffer-read-name-map
                nil nil default))))
      (and (string-equal str "") (setq str default))
Karl Fogel's avatar
Karl Fogel committed
784
      (bookmark-store str (cdr record) no-overwrite)
785

786
      ;; Ask for an annotation buffer for this bookmark
Karl Fogel's avatar
Karl Fogel committed
787 788
      (when bookmark-use-annotations
        (bookmark-edit-annotation str)))))
789 790 791 792

(defun bookmark-kill-line (&optional newline-too)
  "Kill from point to end of line.
If optional arg NEWLINE-TOO is non-nil, delete the newline too.
793
Does not affect the kill ring."
794 795 796 797 798 799
  (let ((eol (save-excursion (end-of-line) (point))))
    (delete-region (point) eol)
    (if (and newline-too (looking-at "\n"))
        (delete-char 1))))


800
;; Defvars to avoid compilation warnings:
801 802 803 804
(defvar bookmark-annotation-name nil
  "Variable holding the name of the bookmark.
This is used in `bookmark-edit-annotation' to record the bookmark
whose annotation is being edited.")
805 806 807


(defun bookmark-default-annotation-text (bookmark)
Karl Fogel's avatar
Karl Fogel committed
808 809 810
  "Return default annotation text for BOOKMARK (a string, not a record).
The default annotation text is simply some text explaining how to use
annotations."
811 812 813 814 815 816 817 818
  (concat "#  Type the annotation for bookmark '" bookmark "' here.\n"
	  "#  All lines which start with a '#' will be deleted.\n"
	  "#  Type C-c C-c when done.\n#\n"
	  "#  Author: " (user-full-name) " <" (user-login-name) "@"
	  (system-name) ">\n"
	  "#  Date:    " (current-time-string) "\n"))


819
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
820
  "Function to return default text to use for a bookmark annotation.
821
It takes one argument, the name of the bookmark, as a string.")
822 823
(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
  'bookmark-edit-annotation-text-func "23.1")
824

825 826 827 828 829
(defvar bookmark-edit-annotation-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map text-mode-map)
    (define-key map "\C-c\C-c" 'bookmark-send-edited-annotation)
    map)
830 831 832 833 834 835 836
  "Keymap for editing an annotation of a bookmark.")


(defun bookmark-edit-annotation-mode (bookmark)
  "Mode for editing the annotation of bookmark BOOKMARK.
When you have finished composing, type \\[bookmark-send-annotation].

Karl Fogel's avatar
Karl Fogel committed
837 838
BOOKMARK is a bookmark name (a string) or a bookmark record.

839
\\{bookmark-edit-annotation-mode-map}"
840 841 842 843 844
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'bookmark-annotation-name)
  (setq bookmark-annotation-name bookmark)
  (use-local-map bookmark-edit-annotation-mode-map)
845 846
  (setq major-mode 'bookmark-edit-annotation-mode
        mode-name "Edit Bookmark Annotation")
847
  (insert (funcall bookmark-edit-annotation-text-func bookmark))
848
  (let ((annotation (bookmark-get-annotation bookmark)))
849
    (if (and annotation (not (string-equal annotation "")))
850
	(insert annotation)))
851
  (run-mode-hooks 'text-mode-hook))
852 853 854


(defun bookmark-send-edited-annotation ()
855 856
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
857 858
  (interactive)
  (if (not (eq major-mode 'bookmark-edit-annotation-mode))
859
      (error "Not in bookmark-edit-annotation-mode"))
860 861 862 863 864
  (goto-char (point-min))
  (while (< (point) (point-max))
    (if (looking-at "^#")
        (bookmark-kill-line t)
      (forward-line 1)))
Stefan Monnier's avatar
Stefan Monnier committed
865 866
  ;; Take no chances with text properties.
  (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
867 868
	(bookmark bookmark-annotation-name))
    (bookmark-set-annotation bookmark annotation)
Karl Fogel's avatar
Karl Fogel committed
869
    (bookmark-bmenu-surreptitiously-rebuild-list))
870 871 872 873
  (kill-buffer (current-buffer)))


(defun bookmark-edit-annotation (bookmark)
Karl Fogel's avatar
Karl Fogel committed
874 875
  "Pop up a buffer for editing bookmark BOOKMARK's annotation.
BOOKMARK is a bookmark name (a string) or a bookmark record."
876 877
  (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
  (bookmark-edit-annotation-mode bookmark))
878

Richard M. Stallman's avatar
Richard M. Stallman committed
879 880

(defun bookmark-insert-current-bookmark ()
Karl Fogel's avatar
Karl Fogel committed
881 882 883
  "Insert into the bookmark name currently being set the value of
`bookmark-current-bookmark' in `bookmark-current-buffer', defaulting
to the buffer's file name if `bookmark-current-bookmark' is nil."
Richard M. Stallman's avatar
Richard M. Stallman committed
884 885
  (interactive)
  (let ((str
Stefan Monnier's avatar
Stefan Monnier committed
886 887 888
	 (with-current-buffer bookmark-current-buffer
	   (or bookmark-current-bookmark
               (bookmark-buffer-name)))))
889 890
    (insert str)))

Richard M. Stallman's avatar
Richard M. Stallman committed
891

892
(defun bookmark-buffer-name ()
893 894
  "Return the name of the current buffer (or its file, if any) in a
way that is suitable as a bookmark name."
895 896 897 898 899 900 901 902 903 904 905 906 907 908 909 910 911 912 913
  (cond
   ;; Or are we a file?
   (buffer-file-name (file-name-nondirectory buffer-file-name))
   ;; Or are we a directory?
   ((and (boundp 'dired-directory) dired-directory)
    (let* ((dirname (if (stringp dired-directory)
                        dired-directory
                      (car dired-directory)))
           (idx (1- (length dirname))))
      ;; Strip the trailing slash.
      (if (= ?/ (aref dirname idx))
          (file-name-nondirectory (substring dirname 0 idx))
        ;; Else return the current-buffer
        (buffer-name (current-buffer)))))
   ;; If all else fails, use the buffer's name.
   (t
    (buffer-name (current-buffer)))))


Richard M. Stallman's avatar
Richard M. Stallman committed
914
(defun bookmark-yank-word ()
Karl Fogel's avatar
Karl Fogel committed
915 916 917
  "Get the next word from buffer `bookmark-current-buffer' and append
it to the name of the bookmark currently being set, advancing
`bookmark-yank-point' by one word." 
Richard M. Stallman's avatar
Richard M. Stallman committed
918
  (interactive)
919 920 921 922 923 924 925
  (let ((string (with-current-buffer bookmark-current-buffer
                  (goto-char bookmark-yank-point)
                  (buffer-substring-no-properties
                   (point)
                   (progn
                     (forward-word 1)
                     (setq bookmark-yank-point (point)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
926 927 928
    (insert string)))

(defun bookmark-buffer-file-name ()
Stefan Monnier's avatar
Stefan Monnier committed
929
  "Return the current buffer's file in a way useful for bookmarks."
930 931 932
  ;; Abbreviate the path, both so it's shorter and so it's more
  ;; portable.  E.g., the user's home dir might be a different
  ;; path on different machines, but "~/" will still reach it.
Lute Kamstra's avatar
Lute Kamstra committed
933
  (abbreviate-file-name
934 935 936 937 938 939 940
   (cond
    (buffer-file-name buffer-file-name)
    ((and (boundp 'dired-directory) dired-directory)
     (if (stringp dired-directory)
         dired-directory
       (car dired-directory)))
    (t (error "Buffer not visiting a file or directory")))))
941 942 943


(defun bookmark-maybe-load-default-file ()
Karl Fogel's avatar
Karl Fogel committed
944
  "If bookmarks have not been loaded from the default place, load them."
945 946
  (and (not bookmarks-already-loaded)
       (null bookmark-alist)
947 948 949 950 951 952 953 954 955 956
       (prog2
           (and
            ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
            ;; to be renamed.
            (file-exists-p (expand-file-name bookmark-old-default-file))
            (not (file-exists-p (expand-file-name bookmark-default-file)))
            (rename-file (expand-file-name bookmark-old-default-file)
                         (expand-file-name bookmark-default-file)))
           ;; return t so the `and' will continue...
           t)
Sam Steingold's avatar
Sam Steingold committed
957

958
       (file-readable-p (expand-file-name bookmark-default-file))
959 960
       (bookmark-load bookmark-default-file t t)
       (setq bookmarks-already-loaded t)))
961