bookmark.el 78.1 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 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 13 14 15 16 17 18 19 20 21 22 23

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; 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
Erik Naggum's avatar
Erik Naggum committed
24
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
25 26
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Erik Naggum's avatar
Erik Naggum committed
27 28 29 30 31 32 33

;;; 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
34 35 36

;; 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
37
;; sent *patches*, bless his soul...
Richard M. Stallman's avatar
Richard M. Stallman committed
38 39 40 41

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

42 43
;; 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
44 45
;; and the menu-bar).

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

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

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

Karl Heuer's avatar
Karl Heuer committed
59
;; Jonathan Stigelman <stig@hackvan.com> gave patches for default
Karl Fogel's avatar
Karl Fogel committed
60 61 62 63
;; 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!)

64 65 66
;; 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
67 68 69
;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad
;; <olstad@msc.edu>.

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

73 74
;; Thank you, Michael Kifer, for contributing the XEmacs support.

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

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

Erik Naggum's avatar
Erik Naggum committed
83 84
(require 'pp)

85
;;; Misc comments:
Richard M. Stallman's avatar
Richard M. Stallman committed
86
;;
87
;; If variable bookmark-use-annotations is non-nil, an annotation is
Sam Steingold's avatar
Sam Steingold committed
88
;; queried for when setting a bookmark.
Richard M. Stallman's avatar
Richard M. Stallman committed
89
;;
90 91 92 93
;; 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
94

95 96
;;; User Variables

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


(defcustom bookmark-use-annotations nil
103
  "*If non-nil, saving a bookmark queries for an annotation in a buffer."
104 105
  :type 'boolean
  :group 'bookmark)
106 107


108
(defcustom bookmark-save-flag t
109
  "*Controls when Emacs saves bookmarks to a file.
110
--> nil means never save bookmarks, except when `bookmark-save' is
111 112
    explicitly called \(\\[bookmark-save]\).
--> t means save bookmarks when Emacs is killed.
113
--> Otherwise, it should be a number that is the frequency with which
114 115 116 117 118 119 120 121 122 123
    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
124
`bookmark-default-file', which is `~/.emacs.bmk' by default."
125
  :type '(choice (const nil) integer (other t))
126
  :group 'bookmark)
127 128 129


(defconst bookmark-old-default-file "~/.emacs-bkmrks"
130
  "*The `.emacs.bmk' file used to be called this name.")
131 132 133 134 135 136


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

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


147
(defcustom bookmark-version-control 'nospecial
148 149 150 151
  "*Whether or not to make numbered backups of the bookmark file.
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
152
use the value of `version-control'."
153 154
  :type '(choice (const nil) (const never) (const nospecial)
		 (other t))
155
  :group 'bookmark)
156 157


158 159 160 161
(defcustom bookmark-completion-ignore-case t
  "*Non-nil means bookmark functions ignore case in completion."
  :type 'boolean
  :group 'bookmark)
162 163


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


172
(defcustom bookmark-automatically-show-annotations t
173
  "*Non-nil means show annotations when jumping to a bookmark."
174 175
  :type 'boolean
  :group 'bookmark)
176 177


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


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

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


195 196 197
(defcustom bookmark-menu-length 70
  "*Maximum length of a bookmark name displayed on a popup menu."
  :type 'integer
198
  :group 'bookmark)
199 200


201 202 203 204 205 206 207
(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")


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

210 211 212 213 214
;; Is it XEmacs?
(defconst bookmark-xemacsp
  (string-match "\\(Lucid\\|Xemacs\\)" emacs-version))


Richard M. Stallman's avatar
Richard M. Stallman committed
215 216 217
;; Added  for lucid emacs  compatibility, db
(or (fboundp 'defalias)  (fset 'defalias 'fset))

218
;; suggested for lucid compatibility by david hughes:
219
(or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
220

221 222

;;; Keymap stuff:
Richard M. Stallman's avatar
Richard M. Stallman committed
223

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

227
;;;###autoload
Richard M. Stallman's avatar
Richard M. Stallman committed
228 229 230 231 232
(defvar bookmark-map nil
  "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
233 234
functions have a binding in this keymap.")

235
;;;###autoload (define-prefix-command 'bookmark-map)
Richard M. Stallman's avatar
Richard M. Stallman committed
236

237 238
;;;###autoload (define-key ctl-x-map "p" bookmark-map)

Richard M. Stallman's avatar
Richard M. Stallman committed
239
;; Read the help on all of these functions for details...
240
;;;###autoload (define-key bookmark-map "x" 'bookmark-set)
241
;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ;"m"ark
242
;;;###autoload (define-key bookmark-map "j" 'bookmark-jump)
243
;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ;"g"o
244 245
;;;###autoload (define-key bookmark-map "i" 'bookmark-insert)
;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks)
246
;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ;"f"ind
247 248 249 250 251
;;;###autoload (define-key bookmark-map "r" 'bookmark-rename)
;;;###autoload (define-key bookmark-map "d" 'bookmark-delete)
;;;###autoload (define-key bookmark-map "l" 'bookmark-load)
;;;###autoload (define-key bookmark-map "w" 'bookmark-write)
;;;###autoload (define-key bookmark-map "s" 'bookmark-save)
Richard M. Stallman's avatar
Richard M. Stallman committed
252

253 254 255 256 257 258 259 260 261 262 263

;;; The annotation maps.
(defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map)
  "Keymap for composing an annotation for a bookmark.")

(define-key bookmark-read-annotation-mode-map "\C-c\C-c"
  'bookmark-send-annotation)



;;; Core variables and data structures:
264
(defvar bookmark-alist ()
265
  "Association list of bookmarks and their records.
266
You probably don't want to change the value of this alist yourself;
267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284
instead, let the various bookmark functions do it for you.

The format of the alist is

       \(BOOKMARK1 BOOKMARK2 ...\)

where each BOOKMARK is of the form

\(NAME
  \(filename . FILE\)
  \(front-context-string . FRONT-STR\)
  \(rear-context-string  . REAR-STR\)
  \(position . POS\)
  \(info-node . POS\)
  \(annotation . ANNOTATION\)\)

So the cdr of each bookmark is an alist too.
`info-node' is optional, by the way.")
285

286

287 288
(defvar bookmarks-already-loaded nil)

289

Richard M. Stallman's avatar
Richard M. Stallman committed
290
;; more stuff added by db.
291

Sam Steingold's avatar
Sam Steingold committed
292
(defvar bookmark-current-bookmark nil
Richard M. Stallman's avatar
Richard M. Stallman committed
293 294
  "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
295
through a file easier.")
Richard M. Stallman's avatar
Richard M. Stallman committed
296 297 298

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

299

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

303 304

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

307

Richard M. Stallman's avatar
Richard M. Stallman committed
308 309 310 311
(defvar bookmark-current-point 0)
(defvar bookmark-yank-point 0)
(defvar bookmark-current-buffer nil)

312 313
(defvar Info-current-node)
(defvar Info-suffix-list)
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.

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


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


(defun bookmark-get-bookmark (bookmark)
336
  "Return the full entry for BOOKMARK in `bookmark-alist'.
337 338
If BOOKMARK is not a string, return nil."
  (when (stringp bookmark)
339
    (assoc-string bookmark bookmark-alist bookmark-completion-ignore-case)))
340 341 342


(defun bookmark-get-bookmark-record (bookmark)
343
  "Return the guts of the entry for BOOKMARK in `bookmark-alist'.
344 345 346 347 348 349
That is, all information but the name."
  (car (cdr (bookmark-get-bookmark bookmark))))


(defun bookmark-set-name (bookmark newname)
  "Set BOOKMARK's name to NEWNAME."
350 351 352
  (setcar
   (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
   newname))
353 354 355 356 357 358 359 360


(defun bookmark-get-annotation (bookmark)
  "Return the annotation of BOOKMARK, or nil if none."
  (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark))))


(defun bookmark-set-annotation (bookmark ann)
361
  "Set the annotation of BOOKMARK to ANN."
362 363 364 365 366 367 368 369 370 371 372 373 374 375 376 377 378 379
  (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell ann)
      (nconc (bookmark-get-bookmark-record bookmark)
             (list (cons 'annotation ann))))))


(defun bookmark-get-filename (bookmark)
  "Return the full filename of BOOKMARK."
  (cdr (assq 'filename (bookmark-get-bookmark-record bookmark))))


(defun bookmark-set-filename (bookmark filename)
  "Set the full filename of BOOKMARK to FILENAME."
  (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell filename)
      (nconc (bookmark-get-bookmark-record bookmark)
380 381 382 383 384
             (list (cons 'filename filename))))
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
    (if (bookmark-time-to-save-p)
        (bookmark-save))))
385 386 387 388 389 390 391 392 393 394 395 396 397 398 399 400 401 402 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431


(defun bookmark-get-position (bookmark)
  "Return the position \(i.e.: point\) of BOOKMARK."
  (cdr (assq 'position (bookmark-get-bookmark-record bookmark))))


(defun bookmark-set-position (bookmark position)
  "Set the position \(i.e.: point\) of BOOKMARK to POSITION."
  (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell position)
      (nconc (bookmark-get-bookmark-record bookmark)
             (list (cons 'position position))))))


(defun bookmark-get-front-context-string (bookmark)
  "Return the front-context-string of BOOKMARK."
  (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark))))


(defun bookmark-set-front-context-string (bookmark string)
  "Set the front-context-string of BOOKMARK to STRING."
  (let ((cell (assq 'front-context-string
                    (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell string)
      (nconc (bookmark-get-bookmark-record bookmark)
             (list (cons 'front-context-string string))))))


(defun bookmark-get-rear-context-string (bookmark)
  "Return the rear-context-string of BOOKMARK."
  (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark))))


(defun bookmark-set-rear-context-string (bookmark string)
  "Set the rear-context-string of BOOKMARK to STRING."
  (let ((cell (assq 'rear-context-string
                    (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell string)
      (nconc (bookmark-get-bookmark-record bookmark)
             (list (cons 'rear-context-string string))))))


(defun bookmark-get-info-node (bookmark)
432
  "Get the info node associated with BOOKMARK."
433
  (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark))))
Sam Steingold's avatar
Sam Steingold committed
434

435 436 437 438 439 440 441 442

(defun bookmark-set-info-node (bookmark node)
  "Set the Info node of BOOKMARK to NODE."
  (let ((cell (assq 'info-node
                    (bookmark-get-bookmark-record bookmark))))
    (if cell
        (setcdr cell node)
      (nconc (bookmark-get-bookmark-record bookmark)
443 444 445
             (list (cons 'info-node node)))))

  (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
446
  (sit-for 4))
Sam Steingold's avatar
Sam Steingold committed
447

448

449 450 451 452
(defvar bookmark-history nil
  "The history list for bookmark functions.")


453 454 455 456 457 458 459
(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
460 461 462 463 464 465 466 467 468 469 470 471 472 473 474
  (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))))
475 476


477 478 479 480
(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
481 482 483
  `(or
    (interactive-p)
    (setq bookmark-history (cons ,string bookmark-history))))
484 485


486
(defun bookmark-make (name &optional annotation overwrite info-node)
487 488 489
  "Make a bookmark named NAME.
Optional second arg ANNOTATION gives it an annotation.
Optional third arg OVERWRITE means replace any existing bookmarks with
490 491 492
this name.
Optional fourth arg INFO-NODE means this bookmark is at info node
INFO-NODE, so record this fact in the bookmark's entry."
493
  (bookmark-maybe-load-default-file)
494
  (let ((stripped-name (copy-sequence name)))
495 496 497 498
    (or bookmark-xemacsp
        ;; XEmacs's `set-text-properties' doesn't work on
        ;; free-standing strings, apparently.
        (set-text-properties 0 (length stripped-name) nil stripped-name))
499
    (if (and (bookmark-get-bookmark stripped-name) (not overwrite))
500
        ;; already existing bookmark under that name and
501 502
        ;; no prefix arg means just overwrite old bookmark
        (setcdr (bookmark-get-bookmark stripped-name)
503
                (list (bookmark-make-cell annotation info-node)))
Sam Steingold's avatar
Sam Steingold committed
504

505 506 507
      ;; 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
508

509 510
      (setq bookmark-alist
            (cons
Sam Steingold's avatar
Sam Steingold committed
511
             (list stripped-name
512
                   (bookmark-make-cell annotation info-node))
513
             bookmark-alist)))
Sam Steingold's avatar
Sam Steingold committed
514

515 516 517 518 519 520
    ;; 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)
        (bookmark-save))))
521 522


523
(defun bookmark-make-cell (annotation &optional info-node)
524
  "Return the record part of a new bookmark, given ANNOTATION.
525
Must be at the correct position in the buffer in which the bookmark is
526 527 528 529
being set.  This might change someday.
Optional second arg INFO-NODE means this bookmark is at info node
INFO-NODE, so record this fact in the bookmark's entry."
  (let ((the-record
530 531 532 533 534 535 536 537 538 539 540 541 542 543
         `((filename . ,(bookmark-buffer-file-name))
           (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)))))
544 545

    ;; Now fill in the optional parts:
546 547 548 549 550

    ;; Take no chances with text properties
    (set-text-properties 0 (length annotation) nil annotation)
    (set-text-properties 0 (length info-node) nil info-node)

551 552 553 554 555 556 557
    (if annotation
        (nconc the-record (list (cons 'annotation annotation))))
    (if info-node
        (nconc the-record (list (cons 'info-node info-node))))

    ;; Finally, return the completed record.
    the-record))
Sam Steingold's avatar
Sam Steingold committed
558 559


560 561 562 563 564 565 566 567 568 569 570 571 572 573 574 575 576 577 578 579 580 581 582 583 584 585 586 587 588 589 590

;;; File format stuff

;; The OLD format of the bookmark-alist was:
;;
;;       ((bookmark-name (filename
;;                        string-in-front
;;                        string-behind
;;                        point))
;;        ...)
;;
;; The NEW format of the bookmark-alist is:
;;
;;       ((bookmark-name ((filename . FILENAME)
;;                        (front-context-string . string-in-front)
;;                        (rear-context-string  . string-behind)
;;                        (position . POINT)
;;                        (annotation . annotation)
;;                        (whatever   . VALUE)
;;                        ...
;;                        ))
;;        ...)
;;
;;
;; 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
591
;; accesses it by from then on.
592 593 594 595 596 597
;;
;; 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
598
;; STRING-BEHIND is the same thing, but after the point.
599 600
;;
;; The context strings exist so that modifications to a file don't
Sam Steingold's avatar
Sam Steingold committed
601
;; necessarily cause a bookmark's position to be invalidated.
602 603 604
;; 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.
605
;; ANNOTATION is the annotation for the bookmark; it may not exist
606 607 608 609 610 611 612 613 614 615 616 617 618 619 620
;; (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 ()
621
  "Return a `bookmark-alist' (in any format) from the current buffer.
622 623 624 625 626 627 628 629 630 631 632 633 634
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.
635
        (error "Not bookmark format")))))
636 637 638


(defun bookmark-upgrade-version-0-alist (old-list)
639
  "Upgrade a version 0 alist OLD-LIST to the current version."
640 641 642 643 644 645 646 647 648 649 650
  (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
651 652 653 654 655
        `((filename             .    ,filename)
          (front-context-string .    ,(or front-str ""))
          (rear-context-string  .    ,(or rear-str  ""))
          (position             .    ,position)
          (annotation           .    ,ann)))))
656 657 658 659 660
   old-list))


(defun bookmark-upgrade-file-format-from-0 ()
  "Upgrade a bookmark file of format 0 (the original format) to format 1.
661
This expects to be called from `point-min' in a bookmark file."
662 663 664 665 666 667 668 669 670
  (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))
671
  (message "Upgrading bookmark format from 0 to %d...done"
672 673 674 675 676 677
           bookmark-file-format-version)
  )


(defun bookmark-grok-file-format-version ()
  "Return an integer which is the file-format version of this bookmark file.
678
This expects to be called from `point-min' in a bookmark file."
679 680 681 682 683 684 685 686 687 688 689 690 691 692
  (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.
693
This expects to be called from `point-min' in a bookmark file."
694 695 696 697 698 699 700
  (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
701
      (error "Bookmark file format version strangeness")))))
702 703 704


(defun bookmark-insert-file-format-version-stamp ()
705
  "Insert text indicating current version of bookmark file format."
706 707 708 709 710 711 712 713 714 715 716
  (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

717 718 719 720 721 722 723 724

;;; 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)))

725 726 727

;;; Core code:

728
;;;###autoload
729 730 731
(defun bookmark-set (&optional name parg)
  "Set a bookmark named NAME inside a file.
If name is nil, then the user will be prompted.
Richard M. Stallman's avatar
Richard M. Stallman committed
732 733 734 735 736 737
With prefix arg, will not overwrite a bookmark that has the same name
as NAME if such a bookmark already exists, but instead will \"push\"
the new bookmark onto the bookmark alist.  Thus the most recently set
bookmark with name NAME would be the one in effect at any given time,
but the others are still there, should you decide to delete the most
recent one.
Richard M. Stallman's avatar
Richard M. Stallman committed
738 739

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
740
bookmark name, type C-w while setting a bookmark.  Successive C-w's
Richard M. Stallman's avatar
Richard M. Stallman committed
741 742
yank successive words.

743 744 745 746
Typing C-u inserts the name of the last bookmark used in the buffer
\(as an aid in using a single bookmark name to track your progress
through a large file\).  If no bookmark was used, then C-u inserts the
name of the file being visited.
Richard M. Stallman's avatar
Richard M. Stallman committed
747 748 749 750

Use \\[bookmark-delete] to remove bookmarks \(you give it a name,
and it removes only the first instance of a bookmark with that name from
the list of bookmarks.\)"
751
  (interactive (list nil current-prefix-arg))
752 753
  (or
   (bookmark-buffer-file-name)
754
   (error "Buffer not visiting a file or directory"))
755 756 757

  (bookmark-maybe-load-default-file)

Richard M. Stallman's avatar
Richard M. Stallman committed
758 759 760
  (setq bookmark-current-point (point))
  (setq bookmark-yank-point (point))
  (setq bookmark-current-buffer (current-buffer))
761

762
  (let* ((default (or bookmark-current-bookmark
763
                      (bookmark-buffer-name)))
764
	 (str
765 766 767 768 769
	  (or name
              (read-from-minibuffer
               (format "Set bookmark (%s): " default)
               nil
               (let ((now-map (copy-keymap minibuffer-local-map)))
770 771
                 (define-key now-map "\C-w" 'bookmark-yank-word)
                 (define-key now-map "\C-u" 'bookmark-insert-current-bookmark)
772
                 now-map))))
773 774
	 (annotation nil))
    (and (string-equal str "") (setq str default))
Sam Steingold's avatar
Sam Steingold committed
775
    ;; Ask for an annotation buffer for this bookmark
776 777
    (if bookmark-use-annotations
	(bookmark-read-annotation parg str)
778 779 780 781
      (bookmark-make str annotation parg (bookmark-info-current-node))
      (setq bookmark-current-bookmark str)
      (bookmark-bmenu-surreptitiously-rebuild-list)
      (goto-char bookmark-current-point))))
782 783


784 785 786 787 788 789
(defun bookmark-info-current-node ()
  "If in Info-mode, return current node name (a string), else nil."
  (if (eq major-mode 'Info-mode)
      Info-current-node))


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 801 802 803 804 805 806 807
;; Defvars to avoid compilation warnings:
(defvar bookmark-annotation-paragraph nil)
(defvar bookmark-annotation-name nil)
(defvar bookmark-annotation-buffer nil)
(defvar bookmark-annotation-file nil)
(defvar bookmark-annotation-point nil)


808
(defun bookmark-send-annotation ()
809 810 811
  "Use buffer contents as the annotation for a bookmark.
Exclude lines that begin with `#'.
Store the annotation text in the bookmark list with
812 813 814
the bookmark (and file, and point) specified in buffer local variables."
  (interactive)
  (if (not (eq major-mode 'bookmark-read-annotation-mode))
815
      (error "Not in bookmark-read-annotation-mode"))
816 817 818 819 820
  (goto-char (point-min))
  (while (< (point) (point-max))
    (if (looking-at "^#")
        (bookmark-kill-line t)
      (forward-line 1)))
821
  (let ((annotation (buffer-string))
822 823 824 825 826 827 828 829 830
	(parg bookmark-annotation-paragraph)
	(bookmark bookmark-annotation-name)
	(pt bookmark-annotation-point)
	(buf bookmark-annotation-buffer))
    ;; for bookmark-make-cell to work, we need to be
    ;; in the relevant buffer, at the relevant point.
    ;; Actually, bookmark-make-cell should probably be re-written,
    ;; to avoid this need.  Should I handle the error if a buffer is
    ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
Sam Steingold's avatar
Sam Steingold committed
831
    (save-excursion
832 833
      (pop-to-buffer buf)
      (goto-char pt)
834
      (bookmark-make bookmark annotation parg (bookmark-info-current-node))
835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850
      (setq bookmark-current-bookmark bookmark))
    (bookmark-bmenu-surreptitiously-rebuild-list)
    (goto-char bookmark-current-point))
  (kill-buffer (current-buffer)))


(defun bookmark-default-annotation-text (bookmark)
  (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"))


(defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text
851
  "Function to return default text to use for a bookmark annotation.
852
It takes one argument, the name of the bookmark, as a string.")
853 854 855

(defun bookmark-read-annotation-mode (buf point parg bookmark)
  "Mode for composing annotations for a bookmark.
856
Wants BUF, POINT, PARG, and BOOKMARK.
857 858 859 860 861 862 863 864 865 866 867 868 869 870 871 872 873 874 875 876
When you have finished composing, type \\[bookmark-send-annotation] to send
the annotation.

\\{bookmark-read-annotation-mode-map}
"
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'bookmark-annotation-paragraph)
  (make-local-variable 'bookmark-annotation-name)
  (make-local-variable 'bookmark-annotation-buffer)
  (make-local-variable 'bookmark-annotation-file)
  (make-local-variable 'bookmark-annotation-point)
  (setq bookmark-annotation-paragraph parg)
  (setq bookmark-annotation-name bookmark)
  (setq bookmark-annotation-buffer buf)
  (setq bookmark-annotation-file (buffer-file-name buf))
  (setq bookmark-annotation-point point)
  (use-local-map bookmark-read-annotation-mode-map)
  (setq major-mode 'bookmark-read-annotation-mode)
  (insert (funcall bookmark-read-annotation-text-func bookmark))
877
  (run-mode-hooks 'text-mode-hook))
878 879 880


(defun bookmark-read-annotation (parg bookmark)
881 882
  "Pop up a buffer for entering a bookmark annotation.
Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK."
883 884 885 886 887 888 889 890 891 892 893 894 895 896 897 898 899 900 901 902 903 904 905 906 907
  (let ((buf (current-buffer))
	(point (point)))
    (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
    (bookmark-read-annotation-mode buf point parg bookmark)))


(defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map)
  "Keymap for editing an annotation of a bookmark.")


(define-key bookmark-edit-annotation-mode-map "\C-c\C-c"
  'bookmark-send-edited-annotation)


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

\\{bookmark-edit-annotation-mode-map}
"
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'bookmark-annotation-name)
  (setq bookmark-annotation-name bookmark)
  (use-local-map bookmark-edit-annotation-mode-map)
908 909
  (setq major-mode 'bookmark-edit-annotation-mode
        mode-name "Edit Bookmark Annotation")
910 911
  (insert (funcall bookmark-read-annotation-text-func bookmark))
  (let ((annotation (bookmark-get-annotation bookmark)))
912
    (if (and annotation (not (string-equal annotation "")))
913
	(insert annotation)))
914
  (run-mode-hooks 'text-mode-hook))
915 916 917


(defun bookmark-send-edited-annotation ()
918 919
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
920 921
  (interactive)
  (if (not (eq major-mode 'bookmark-edit-annotation-mode))
922
      (error "Not in bookmark-edit-annotation-mode"))
923 924 925 926 927
  (goto-char (point-min))
  (while (< (point) (point-max))
    (if (looking-at "^#")
        (bookmark-kill-line t)
      (forward-line 1)))
928
  (let ((annotation (buffer-string))
929 930 931 932 933 934 935 936 937
	(bookmark bookmark-annotation-name))
    (bookmark-set-annotation bookmark annotation)
    (bookmark-bmenu-surreptitiously-rebuild-list)
    (goto-char bookmark-current-point))
  (kill-buffer (current-buffer)))


(defun bookmark-edit-annotation (bookmark)
  "Pop up a buffer for editing bookmark BOOKMARK's annotation."
938 939
  (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
  (bookmark-edit-annotation-mode bookmark))
940

Richard M. Stallman's avatar
Richard M. Stallman committed
941 942

(defun bookmark-insert-current-bookmark ()
943
  "Insert this buffer's value of `bookmark-current-bookmark'.
944
Default to file name if it's nil."
Richard M. Stallman's avatar
Richard M. Stallman committed
945 946 947 948 949
  (interactive)
  (let ((str
	 (save-excursion
	   (set-buffer bookmark-current-buffer)
	   bookmark-current-bookmark)))
950
    (if str (insert str) (bookmark-insert-buffer-name))))
Richard M. Stallman's avatar
Richard M. Stallman committed
951

952

953
(defun bookmark-insert-buffer-name ()
954 955
  "Insert the current file name into the bookmark name being set.
The directory part of the file name is not used."
Richard M. Stallman's avatar
Richard M. Stallman committed
956
  (interactive)
957 958 959
  (let ((str
         (save-excursion
           (set-buffer bookmark-current-buffer)
960
           (bookmark-buffer-name))))
961 962
    (insert str)))

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

964 965 966 967 968 969 970 971 972 973 974 975 976 977 978 979 980 981 982 983 984 985 986 987
(defun bookmark-buffer-name ()
  "Return the name of the current buffer's file, non-directory.
In Info, return the current node."
  (cond
   ;; Are we in Info?
   ((string-equal mode-name "Info") Info-current-node)
   ;; 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
988 989 990 991 992
(defun bookmark-yank-word ()
  (interactive)
  ;; get the next word from the buffer and append it to the name of
  ;; the bookmark currently being set.
  (let ((string (save-excursion
993 994
                    (set-buffer bookmark-current-buffer)
                    (goto-char bookmark-yank-point)
995
                    (buffer-substring-no-properties
996
                     (point)
997
                     (progn
998 999
                       (forward-word 1)
                       (setq bookmark-yank-point (point)))))))
Richard M. Stallman's avatar
Richard M. Stallman committed
1000 1001 1002
    (insert string)))


1003 1004
(defvar Info-current-file)

Richard M. Stallman's avatar
Richard M. Stallman committed
1005
(defun bookmark-buffer-file-name ()
1006 1007
  "Return the current buffer's file in a way useful for bookmarks.
For example, if this is a Info buffer, return the Info file's name."
1008 1009 1010 1011 1012 1013 1014 1015 1016 1017 1018 1019
  (cond
   ((eq major-mode 'Info-mode)
    Info-current-file)
   (buffer-file-name
    ;; 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.
    (abbreviate-file-name buffer-file-name))
   ((and (boundp 'dired-directory) dired-directory)
    (if (stringp dired-directory)
        dired-directory
      (car dired-directory)))))
1020 1021 1022


(defun bookmark-maybe-load-default-file ()
1023 1024
  (and (not bookmarks-already-loaded)
       (null bookmark-alist)
1025 1026 1027 1028 1029 1030 1031 1032 1033 1034
       (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
1035

1036
       (file-readable-p (expand-file-name bookmark-default-file))
1037 1038
       (bookmark-load bookmark-default-file t t)
       (setq bookmarks-already-loaded t)))
1039

1040

1041 1042 1043 1044 1045 1046 1047 1048 1049
(defun bookmark-maybe-sort-alist ()
  ;;Return the bookmark-alist for display.  If the bookmark-sort-flag
  ;;is non-nil, then return a sorted copy of the alist.
  (if bookmark-sort-flag
      (setq bookmark-alist
            (sort (copy-alist bookmark-alist)
                  (function
                   (lambda (x y) (string-lessp (car x) (car y))))))))

1050

1051 1052 1053 1054
(defvar bookmark-after-jump-hook nil
  "Hook run after `bookmark-jump' jumps to a bookmark.
Useful for example to unhide text in `outline-mode'.")

1055
;;;###autoload
1056
(defun bookmark-jump (bookmark)
Sam Steingold's avatar
Sam Steingold committed
1057
  "Jump to bookmark BOOKMARK (a point in some file).
Richard M. Stallman's avatar
Richard M. Stallman committed
1058 1059 1060
You may have a problem using this function if the value of variable
`bookmark-alist' is nil.  If that happens, you need to load in some
bookmarks.  See help on function `bookmark-load' for more about
1061 1062
this.

1063
If the file pointed to by BOOKMARK no longer exists, you will be asked
1064
if you wish to give the bookmark a new location, and `bookmark-jump'