bookmark.el 82.7 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-1997, 2001-2011  Free Software Foundation, Inc.
Richard M. Stallman's avatar
Richard M. Stallman committed
4

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

;; This file is part of GNU Emacs.

12
;; GNU Emacs is free software: you can redistribute it and/or modify
Richard M. Stallman's avatar
Richard M. Stallman committed
13
;; it under the terms of the GNU General Public License as published by
14 15
;; 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
16 17 18 19 20 21 22

;; 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
23
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
Erik Naggum's avatar
Erik Naggum committed
24 25 26 27 28 29 30

;;; 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
31

32

33
;;; Code:
Richard M. Stallman's avatar
Richard M. Stallman committed
34

Erik Naggum's avatar
Erik Naggum committed
35
(require 'pp)
36
(eval-when-compile (require 'cl))
Erik Naggum's avatar
Erik Naggum committed
37

38
;;; Misc comments:
Richard M. Stallman's avatar
Richard M. Stallman committed
39
;;
40
;; If variable bookmark-use-annotations is non-nil, an annotation is
Sam Steingold's avatar
Sam Steingold committed
41
;; queried for when setting a bookmark.
Richard M. Stallman's avatar
Richard M. Stallman committed
42
;;
43 44 45 46
;; 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
47

48 49
;;; User Variables

50
(defgroup bookmark nil
51
  "Setting, annotation and jumping to bookmarks."
52 53 54 55
  :group 'matching)


(defcustom bookmark-use-annotations nil
Stefan Monnier's avatar
Stefan Monnier committed
56
  "If non-nil, saving a bookmark queries for an annotation in a buffer."
57 58
  :type 'boolean
  :group 'bookmark)
59 60


61
(defcustom bookmark-save-flag t
Stefan Monnier's avatar
Stefan Monnier committed
62
  "Controls when Emacs saves bookmarks to a file.
63
--> nil means never save bookmarks, except when `bookmark-save' is
64
    explicitly called (\\[bookmark-save]).
65
--> t means save bookmarks when Emacs is killed.
66
--> Otherwise, it should be a number that is the frequency with which
67
    the bookmark list is saved (i.e.: the number of times which
68
    Emacs' bookmark list may be modified before it is automatically
69
    saved.).  If it is a number, Emacs will also automatically save
70 71 72
    bookmarks when it is killed.

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

To specify the file in which to save them, modify the variable
77
`bookmark-default-file', which is `~/.emacs.bmk' by default."
78
  :type '(choice (const nil) integer (other t))
79
  :group 'bookmark)
80 81 82


(defconst bookmark-old-default-file "~/.emacs-bkmrks"
Lute Kamstra's avatar
Lute Kamstra committed
83
  "The `.emacs.bmk' file used to be called this name.")
84 85 86 87 88 89


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

90
(defcustom bookmark-default-file
91 92 93
  (if bookmark-file
      ;; In case user set `bookmark-file' in her .emacs:
      bookmark-file
94
    (locate-user-emacs-file "bookmarks" ".emacs.bmk"))
Stefan Monnier's avatar
Stefan Monnier committed
95
  "File in which to save bookmarks by default."
96 97
  :type 'file
  :group 'bookmark)
98 99


100
(defcustom bookmark-version-control 'nospecial
Stefan Monnier's avatar
Stefan Monnier committed
101
  "Whether or not to make numbered backups of the bookmark file.
102 103 104
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
105
use the value of `version-control'."
106 107
  :type '(choice (const nil) (const never) (const nospecial)
		 (other t))
108
  :group 'bookmark)
109 110


111
(defcustom bookmark-completion-ignore-case t
Stefan Monnier's avatar
Stefan Monnier committed
112
  "Non-nil means bookmark functions ignore case in completion."
113 114
  :type 'boolean
  :group 'bookmark)
115 116


117
(defcustom bookmark-sort-flag t
Stefan Monnier's avatar
Stefan Monnier committed
118
  "Non-nil means that bookmarks will be displayed sorted by bookmark name.
119
Otherwise they will be displayed in LIFO order (that is, most
120 121 122
recently set ones come first, oldest ones come last)."
  :type 'boolean
  :group 'bookmark)
123 124


125
(defcustom bookmark-automatically-show-annotations t
Stefan Monnier's avatar
Stefan Monnier committed
126
  "Non-nil means show annotations when jumping to a bookmark."
127 128
  :type 'boolean
  :group 'bookmark)
129 130


131 132 133
(defconst bookmark-bmenu-header-height 2
  "Number of lines used for the *Bookmark List* header.")

134 135 136
(defconst bookmark-bmenu-marks-width 2
  "Number of columns (chars) used for the *Bookmark List* marks column,
including the annotations column.")
137

138
(defcustom bookmark-bmenu-file-column 30
Stefan Monnier's avatar
Stefan Monnier committed
139
  "Column at which to display filenames in a buffer listing bookmarks.
140 141 142
You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
  :type 'integer
  :group 'bookmark)
143 144


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

150
\(setq bookmark-bmenu-toggle-filenames nil)"
151 152
  :type 'boolean
  :group 'bookmark)
153 154


155
(defcustom bookmark-menu-length 70
Stefan Monnier's avatar
Stefan Monnier committed
156
  "Maximum length of a bookmark name displayed on a popup menu."
157
  :type 'integer
158
  :group 'bookmark)
159

160
;; FIXME: Is it really worth a customization option?
161
(defcustom bookmark-search-delay 0.2
162
  "Time before `bookmark-bmenu-search' updates the display."
163 164 165
  :group 'bookmark
  :type  'integer)

166 167 168 169 170 171 172
(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")


173
;;; No user-serviceable parts beyond this point.
Richard M. Stallman's avatar
Richard M. Stallman committed
174 175 176 177

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

178
;; suggested for lucid compatibility by david hughes:
179
(or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
180

181 182

;;; Keymap stuff:
Richard M. Stallman's avatar
Richard M. Stallman committed
183

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

187 188 189
;;;###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)
190

191
;;;###autoload
192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208
(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
209 210 211 212
  "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
213 214
functions have a binding in this keymap.")

215
;;;###autoload (fset 'bookmark-map bookmark-map)
216 217 218


;;; Core variables and data structures:
219
(defvar bookmark-alist ()
220
  "Association list of bookmarks and their records.
221 222
Bookmark functions update the value automatically.
You probably do NOT want to change the value yourself.
223

224
The value is an alist with entries of the form
225

226
 (BOOKMARK-NAME . PARAM-ALIST)
227

228
or the deprecated form (BOOKMARK-NAME PARAM-ALIST).
229

230
 BOOKMARK-NAME is the name you gave to the bookmark when creating it.
231

232 233 234 235
 PARAM-ALIST is an alist of bookmark information.  The order of the
 entries in PARAM-ALIST is not important.  The possible entries are
 described below.  An entry with a key but null value means the entry
 is not used.
236

237
  (filename . FILENAME)
238
  (position . POS)
239 240 241 242 243 244 245 246 247 248 249 250 251 252 253
  (front-context-string . STR-AFTER-POS)
  (rear-context-string  . STR-BEFORE-POS)
  (handler . HANDLER)
  (annotation . ANNOTATION)

 FILENAME names the bookmarked file.
 POS is the bookmarked buffer position (position in the file).
 STR-AFTER-POS is buffer text that immediately follows POS.
 STR-BEFORE-POS is buffer text that immediately precedes POS.
 ANNOTATION is a string that describes the bookmark.
   See options `bookmark-use-annotations' and
   `bookmark-automatically-show-annotations'.
 HANDLER is a function that provides the bookmark-jump behavior for a
 specific kind of bookmark.  This is the case for Info bookmarks,
 for instance.  HANDLER must accept a bookmark as argument.")
254

Karl Fogel's avatar
Karl Fogel committed
255
(defvar bookmarks-already-loaded nil
256
  "Non-nil if and only if bookmarks have been loaded from `bookmark-default-file'.")
257

258

Richard M. Stallman's avatar
Richard M. Stallman committed
259
;; more stuff added by db.
260

Sam Steingold's avatar
Sam Steingold committed
261
(defvar bookmark-current-bookmark nil
Richard M. Stallman's avatar
Richard M. Stallman committed
262 263
  "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
264
through a file easier.")
Richard M. Stallman's avatar
Richard M. Stallman committed
265 266 267

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

268

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

272 273

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

276

Karl Fogel's avatar
Karl Fogel committed
277 278 279 280 281 282 283 284 285
(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'.
286
This point is in `bookmark-current-buffer'.")
Karl Fogel's avatar
Karl Fogel committed
287

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

289 290
(defvar bookmark-quit-flag nil
  "Non nil make `bookmark-bmenu-search' quit immediately.")
291

292 293 294 295 296 297 298 299 300 301 302 303
;; Helper functions and macros.

(defmacro with-buffer-modified-unmodified (&rest body)
  "Run BODY while preserving the buffer's `buffer-modified-p' state."
  (let ((was-modified (make-symbol "was-modified")))
    `(let ((,was-modified (buffer-modified-p)))
       (unwind-protect
           (progn ,@body)
         (set-buffer-modified-p ,was-modified)))))

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

306
(defun bookmark-name-from-full-record (bookmark-record)
307 308 309
  "Return the name of BOOKMARK-RECORD.  BOOKMARK-RECORD is, e.g.,
one element from `bookmark-alist'."
  (car bookmark-record))
310 311 312 313 314


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


318 319 320 321 322 323
(defun bookmark-get-bookmark (bookmark-name-or-record &optional noerror)
  "Return the bookmark record corresponding to BOOKMARK-NAME-OR-RECORD.
If BOOKMARK-NAME-OR-RECORD is a string, look for the corresponding
bookmark record in `bookmark-alist'; return it if found, otherwise
error.  Else if BOOKMARK-NAME-OR-RECORD is already a bookmark record,
just return it."
324
  (cond
325 326 327 328 329 330 331 332 333 334 335 336
   ((consp bookmark-name-or-record) bookmark-name-or-record)
   ((stringp bookmark-name-or-record)
    (or (assoc-string bookmark-name-or-record bookmark-alist
                      bookmark-completion-ignore-case)
        (unless noerror (error "Invalid bookmark %s"
                               bookmark-name-or-record))))))


(defun bookmark-get-bookmark-record (bookmark-name-or-record)
  "Return the record portion of the entry for BOOKMARK-NAME-OR-RECORD in
`bookmark-alist' (that is, all information but the name)."
  (let ((alist (cdr (bookmark-get-bookmark bookmark-name-or-record))))
337 338 339 340
    ;; 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)))
341 342


343 344 345
(defun bookmark-set-name (bookmark-name-or-record newname)
  "Set BOOKMARK-NAME-OR-RECORD's name to NEWNAME."
  (setcar (bookmark-get-bookmark bookmark-name-or-record) newname))
346

347 348 349
(defun bookmark-prop-get (bookmark-name-or-record prop)
  "Return the property PROP of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (cdr (assq prop (bookmark-get-bookmark-record bookmark-name-or-record))))
350

351 352 353 354
(defun bookmark-prop-set (bookmark-name-or-record prop val)
  "Set the property PROP of BOOKMARK-NAME-OR-RECORD to VAL."
  (let ((cell (assq
               prop (bookmark-get-bookmark-record bookmark-name-or-record))))
355 356
    (if cell
        (setcdr cell val)
357
      (nconc (bookmark-get-bookmark-record bookmark-name-or-record)
358
             (list (cons prop val))))))
359

360 361 362
(defun bookmark-get-annotation (bookmark-name-or-record)
  "Return the annotation of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'annotation))
363

364 365 366
(defun bookmark-set-annotation (bookmark-name-or-record ann)
  "Set the annotation of BOOKMARK-NAME-OR-RECORD to ANN."
  (bookmark-prop-set bookmark-name-or-record 'annotation ann))
367 368


369 370 371
(defun bookmark-get-filename (bookmark-name-or-record)
  "Return the full filename of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'filename))
372 373


374 375 376
(defun bookmark-set-filename (bookmark-name-or-record filename)
  "Set the full filename of BOOKMARK-NAME-OR-RECORD to FILENAME."
  (bookmark-prop-set bookmark-name-or-record 'filename filename))
377 378


379 380 381
(defun bookmark-get-position (bookmark-name-or-record)
  "Return the position (i.e.: point) of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'position))
382 383


384 385 386
(defun bookmark-set-position (bookmark-name-or-record position)
  "Set the position (i.e.: point) of BOOKMARK-NAME-OR-RECORD to POSITION."
  (bookmark-prop-set bookmark-name-or-record 'position position))
387 388


389 390 391
(defun bookmark-get-front-context-string (bookmark-name-or-record)
  "Return the front-context-string of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'front-context-string))
392 393


394 395 396
(defun bookmark-set-front-context-string (bookmark-name-or-record string)
  "Set the front-context-string of BOOKMARK-NAME-OR-RECORD to STRING."
  (bookmark-prop-set bookmark-name-or-record 'front-context-string string))
397 398


399 400 401
(defun bookmark-get-rear-context-string (bookmark-name-or-record)
  "Return the rear-context-string of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'rear-context-string))
402 403


404 405 406
(defun bookmark-set-rear-context-string (bookmark-name-or-record string)
  "Set the rear-context-string of BOOKMARK-NAME-OR-RECORD to STRING."
  (bookmark-prop-set bookmark-name-or-record 'rear-context-string string))
407 408


409 410 411
(defun bookmark-get-handler (bookmark-name-or-record)
  "Return the handler function for BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'handler))
412

413 414 415 416
(defvar bookmark-history nil
  "The history list for bookmark functions.")


417 418 419 420 421 422 423
(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
424
  (if (listp last-nonmenu-event)
425 426 427 428 429
      (bookmark-menu-popup-paned-menu t prompt
				      (if bookmark-sort-flag
					  (sort (bookmark-all-names)
						'string-lessp)
					(bookmark-all-names)))
430 431
    (let* ((completion-ignore-case bookmark-completion-ignore-case)
	   (default default)
432 433 434
	   (prompt (concat prompt (if default
                                      (format " (%s): " default)
                                    ": ")))
435 436 437 438 439 440 441 442
	   (str
	    (completing-read prompt
			     bookmark-alist
			     nil
			     0
			     nil
			     'bookmark-history)))
      (if (string-equal "" str) default str))))
443 444


445 446 447 448
(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
449
  `(or
450
    (called-interactively-p 'interactive)
Sam Steingold's avatar
Sam Steingold committed
451
    (setq bookmark-history (cons ,string bookmark-history))))
452

453
(defvar bookmark-make-record-function 'bookmark-make-record-default
454 455 456 457
  "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.
458

459
The function will be called with no arguments.
460 461
It should signal a user error if it is unable to construct a record for
the current location.
462 463 464

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
465 466 467
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.
468 469

NAME is a suggested name for the constructed bookmark.  It can be nil
470 471
in which case a default heuristic will be used.  The function can also
equivalently just return ALIST without NAME.")
472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488

(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."
489
  (bookmark-maybe-load-default-file)
490
  (let ((stripped-name (copy-sequence name)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
491
    (or (featurep 'xemacs)
492 493 494
        ;; XEmacs's `set-text-properties' doesn't work on
        ;; free-standing strings, apparently.
        (set-text-properties 0 (length stripped-name) nil stripped-name))
495 496
    (if (and (not no-overwrite)
             (bookmark-get-bookmark stripped-name 'noerror))
497
        ;; already existing bookmark under that name and
498
        ;; no prefix arg means just overwrite old bookmark
499 500
        ;; Use the new (NAME . ALIST) format.
        (setcdr (bookmark-get-bookmark stripped-name) alist)
Sam Steingold's avatar
Sam Steingold committed
501

502 503 504
      ;; 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
505

506
      (push (cons stripped-name alist) bookmark-alist))
Sam Steingold's avatar
Sam Steingold committed
507

508 509 510 511 512
    ;; 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)
513
        (bookmark-save))
514

515 516
    (setq bookmark-current-bookmark stripped-name)
    (bookmark-bmenu-surreptitiously-rebuild-list)))
517

518
(defun bookmark-make-record-default (&optional no-file no-context posn)
519
  "Return the record describing the location of a new bookmark.
520 521 522 523 524 525 526 527 528 529 530 531 532 533 534 535 536 537 538 539 540 541 542 543 544 545 546 547
Point should be at the buffer in which the bookmark is being set,
and normally should be at the position where the bookmark is desired,
but see the optional arguments for other possibilities.

If NO-FILE is non-nil, then only return the subset of the
record that pertains to the location within the buffer, leaving off
the part that records the filename.

If NO-CONTEXT is non-nil, do not include the front- and rear-context
strings in the record -- the position is enough.

If POSN is non-nil, record POSN as the point instead of `(point)'."
  `(,@(unless no-file `((filename . ,(bookmark-buffer-file-name))))
    ,@(unless no-context `((front-context-string
                           . ,(if (>= (- (point-max) (point))
                                      bookmark-search-size)
                                  (buffer-substring-no-properties
                                   (point)
                                   (+ (point) bookmark-search-size))
                                  nil))))
    ,@(unless no-context `((rear-context-string
                           . ,(if (>= (- (point) (point-min))
                                      bookmark-search-size)
                                  (buffer-substring-no-properties
                                   (point)
                                   (- (point) bookmark-search-size))
                                  nil))))
    (position . ,(or posn (point)))))
Sam Steingold's avatar
Sam Steingold committed
548

549 550 551

;;; File format stuff

552 553 554 555 556 557 558 559 560 561
;; *IMPORTANT NOTICE* If you are thinking about modifying (redefining)
;; the bookmark file format -- please don't.  The current format
;; should be extensible enough.  If you feel the need to change it,
;; please discuss it with other Emacs developers first.
;;
;; The format of `bookmark-alist' has changed twice in its lifetime.
;; This comment describes the three formats, FIRST, SECOND, and
;; CURRENT.
;;
;; The FIRST format was used prior to Emacs 20:
562
;;
563
;;       ((BOOKMARK-NAME (FILENAME
564 565 566
;;                          STRING-IN-FRONT
;;                          STRING-BEHIND
;;                          POINT))
567 568
;;        ...)
;;
569 570 571 572 573 574 575 576 577 578 579 580 581
;; The SECOND format was introduced in Emacs 20:
;;
;;       ((BOOKMARK-NAME ((filename   . FILENAME)
;;                        (position   . POS)
;;                        (front-context-string . STR-AFTER-POS)
;;                        (rear-context-string  . STR-BEFORE-POS)
;;                        (annotation . ANNOTATION)
;;                        (whatever   . VALUE)
;;                        ...
;;                       ))
;;        ...)
;;
;; The CURRENT format was introduced in Emacs 22:
582
;;
583
;;       ((BOOKMARK-NAME (filename   . FILENAME)
584 585 586
;;                       (position   . POS)
;;                       (front-context-string . STR-AFTER-POS)
;;                       (rear-context-string  . STR-BEFORE-POS)
587 588 589
;;                       (annotation . ANNOTATION)
;;                       (whatever   . VALUE)
;;                       ...
590
;;                       )
591 592
;;        ...)
;;
593 594 595 596 597 598 599 600
;; Both FIRST and SECOND have the same level of nesting: the cadr of a
;; bookmark record is a list of entry information.  FIRST and SECOND
;; differ in the form of the record information: FIRST uses a list of
;; atoms, and SECOND uses an alist.  In the FIRST format, the order of
;; the list elements matters.  In the SECOND format, the order of the
;; alist elements is unimportant.  The SECOND format facilitates the
;; addition of new kinds of elements, to support new kinds of
;; bookmarks or code evolution.
601
;;
602 603 604 605 606
;; The CURRENT format removes a level of nesting wrt FIRST and SECOND,
;; saving one cons cell per bookmark: the cadr of a bookmark record is
;; no longer a cons.  Why that change was made remains a mystery --
;; just be aware of it.  (Be aware too that this explanatory comment
;; was incorrect in Emacs 22 and Emacs 23.1.)
607
;;
608 609 610
;; To deal with the change from FIRST format to SECOND, conversion
;; code was added, and it is still in use.  See
;; `bookmark-maybe-upgrade-file-format'.
611
;;
612 613
;; No conversion from SECOND to CURRENT is done.  Instead, the code
;; handles both formats OK.  It must continue to do so.
614
;;
615 616
;; See the doc string of `bookmark-alist' for information about the
;; elements that define a bookmark (e.g. `filename').
617 618 619 620 621 622 623 624 625 626 627 628 629


(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 ()
630
  "Return a `bookmark-alist' (in any format) from the current buffer.
631 632 633 634 635 636 637 638 639 640 641 642 643
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.
644
        (error "Not bookmark format")))))
645 646 647


(defun bookmark-upgrade-version-0-alist (old-list)
648
  "Upgrade a version 0 alist OLD-LIST to the current version."
649 650 651 652 653 654 655 656 657 658 659
  (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
660 661 662 663 664
        `((filename             .    ,filename)
          (front-context-string .    ,(or front-str ""))
          (rear-context-string  .    ,(or rear-str  ""))
          (position             .    ,position)
          (annotation           .    ,ann)))))
665 666 667 668 669
   old-list))


(defun bookmark-upgrade-file-format-from-0 ()
  "Upgrade a bookmark file of format 0 (the original format) to format 1.
670
This expects to be called from `point-min' in a bookmark file."
671 672 673 674 675 676 677 678 679
  (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))
680
  (message "Upgrading bookmark format from 0 to %d...done"
681 682 683 684 685 686
           bookmark-file-format-version)
  )


(defun bookmark-grok-file-format-version ()
  "Return an integer which is the file-format version of this bookmark file.
687
This expects to be called from `point-min' in a bookmark file."
688 689 690 691 692 693 694 695 696 697 698 699 700 701
  (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.
702
This expects to be called from `point-min' in a bookmark file."
703 704 705 706 707 708 709
  (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
710
      (error "Bookmark file format version strangeness")))))
711 712 713


(defun bookmark-insert-file-format-version-stamp ()
714
  "Insert text indicating current version of bookmark file format."
715 716 717 718 719 720 721 722 723 724 725
  (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

726 727 728 729 730 731 732 733

;;; 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)))

734 735 736

;;; Core code:

Stefan Monnier's avatar
Stefan Monnier committed
737 738 739 740 741 742 743 744 745 746
(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))

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

752 753 754 755 756 757
With a prefix arg (non-nil NO-OVERWRITE), do not overwrite any
existing bookmark that has the same name as NAME, but instead push the
new bookmark onto the bookmark alist.  The most recently set bookmark
with name NAME is thus the one in 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
758 759

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

763 764 765 766 767
Typing C-u inserts (at the bookmark name prompt) the name of the last
bookmark used in the document where the new bookmark is being set;
this helps you 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
768

769
Use \\[bookmark-delete] to remove bookmarks (you give it a name and
770
it removes only the first instance of a bookmark with that name from
771
the list of bookmarks.)"
772
  (interactive (list nil current-prefix-arg))
773 774 775 776 777 778 779 780 781 782 783 784 785 786 787 788 789 790 791 792 793 794 795 796 797 798 799 800
  (unwind-protect
       (let* ((record (bookmark-make-record))
              (default (car record)))

         (bookmark-maybe-load-default-file)
         ;; Don't set `bookmark-yank-point' and `bookmark-current-buffer'
         ;; if they have been already set in another buffer. (e.g gnus-art).
         (unless (and bookmark-yank-point
                      bookmark-current-buffer)
           (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))
           (bookmark-store str (cdr record) no-overwrite)

           ;; Ask for an annotation buffer for this bookmark
           (when bookmark-use-annotations
             (bookmark-edit-annotation str))))
    (setq bookmark-yank-point nil)
    (setq bookmark-current-buffer nil)))

801 802 803 804

(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.
805
Does not affect the kill ring."
806
  (let ((eol (line-end-position)))
807 808 809 810 811
    (delete-region (point) eol)
    (if (and newline-too (looking-at "\n"))
        (delete-char 1))))


812
;; Defvars to avoid compilation warnings:
813 814 815 816
(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.")
817 818


819 820
(defun bookmark-default-annotation-text (bookmark-name)
  "Return default annotation text for BOOKMARK-NAME.
Karl Fogel's avatar
Karl Fogel committed
821 822
The default annotation text is simply some text explaining how to use
annotations."
823
  (concat "#  Type the annotation for bookmark '" bookmark-name "' here.\n"
824 825 826 827 828 829 830
	  "#  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"))


831
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
832
  "Function to return default text to use for a bookmark annotation.
833
It takes one argument, the name of the bookmark, as a string.")
834 835
(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
  'bookmark-edit-annotation-text-func "23.1")
836

837 838 839 840 841
(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)
842 843 844
  "Keymap for editing an annotation of a bookmark.")


845 846
(defun bookmark-edit-annotation-mode (bookmark-name-or-record)
  "Mode for editing the annotation of bookmark BOOKMARK-NAME-OR-RECORD.
847 848
When you have finished composing, type \\[bookmark-send-annotation].

849
\\{bookmark-edit-annotation-mode-map}"
850 851 852
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'bookmark-annotation-name)
853
  (setq bookmark-annotation-name bookmark-name-or-record)
854
  (use-local-map bookmark-edit-annotation-mode-map)
855 856
  (setq major-mode 'bookmark-edit-annotation-mode
        mode-name "Edit Bookmark Annotation")
857 858
  (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record))
  (let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
859
    (if (and annotation (not (string-equal annotation "")))
860
	(insert annotation)))
861
  (run-mode-hooks 'text-mode-hook))
862 863 864


(defun bookmark-send-edited-annotation ()
865 866
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
867 868
  (interactive)
  (if (not (eq major-mode 'bookmark-edit-annotation-mode))
869
      (error "Not in bookmark-edit-annotation-mode"))
870 871 872 873 874
  (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
875 876
  ;; Take no chances with text properties.
  (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
877 878
	(bookmark-name bookmark-annotation-name))
    (bookmark-set-annotation bookmark-name annotation)
879 880
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
Karl Fogel's avatar
Karl Fogel committed
881
    (bookmark-bmenu-surreptitiously-rebuild-list))
882 883 884
  (kill-buffer (current-buffer)))


885 886
(defun bookmark-edit-annotation (bookmark-name-or-record)
  "Pop up a buffer for editing bookmark BOOKMARK-NAME-OR-RECORD's annotation."
887
  (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
888
  (bookmark-edit-annotation-mode bookmark-name-or-record))
889

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

(defun bookmark-insert-current-bookmark ()
Karl Fogel's avatar
Karl Fogel committed
892 893 894
  "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
895 896
  (interactive)
  (let ((str
Stefan Monnier's avatar
Stefan Monnier committed
897 898 899
	 (with-current-buffer bookmark-current-buffer
	   (or bookmark-current-bookmark
               (bookmark-buffer-name)))))
900 901
    (insert str)))

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

903
(defun bookmark-buffer-name ()
904 905
  "Return the name of the current buffer in a form usable as a bookmark name.
If the buffer is associated with a file or directory, use that name."
906 907 908 909 910 911 912 913 914 915 916 917 918 919 920 921 922 923 924
  (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
925
(defun bookmark-yank-word ()
Karl Fogel's avatar
Karl Fogel committed
926 927
  "Get the next word from buffer `bookmark-current-buffer' and append
it to the name of the bookmark currently being set, advancing
928
`bookmark-yank-point' by one word."
Richard M. Stallman's avatar
Richard M. Stallman committed
929
  (interactive)
930 931 932 933 934 935 936
  (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
937 938 939
    (insert string)))

(defun bookmark-buffer-file-name ()
Stefan Monnier's avatar
Stefan Monnier committed
940
  "Return the current buffer's file in a way useful for bookmarks."
941 942 943
  ;; 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
944
  (abbreviate-file-name
945 946 947 948 949 950 951
   (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")))))
952 953 954


(defun bookmark-maybe-load-default-file ()
Karl Fogel's avatar
Karl Fogel committed
955
  "If bookmarks have not been loaded from the default place, load them."
956 957
  (and (not bookmarks-already-loaded)
       (null bookmark-alist)
958 959 960 961
       (prog2
           (and
            ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
            ;; to be renamed.
962 963 964 965
            (file-exists-p bookmark-old-default-file)
            (not (file-exists-p bookmark-default-file))
            (rename-file bookmark-old-default-file
                         bookmark-default-file))
966 967
           ;; return t so the `and' will continue...
           t)
Sam Steingold's avatar
Sam Steingold committed
968

969
       (file-readable-p bookmark-default-file)
970 971
       (bookmark-load bookmark-default-file t t)
       (setq bookmarks-already-loaded t)))
972

973

974
(defun bookmark-maybe-sort-alist ()
Karl Fogel's avatar
Karl Fogel committed
975 976
  "Return `bookmark-alist' for display.
If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist."
977
  (if bookmark-sort-flag
978 979 980 981
      (sort (copy-alist bookmark-alist)
            (function
             (lambda (x y) (string-lessp (car x) (car y)))))
    bookmark-alist))
982

983

984 985 986 987
(defvar bookmark-after-jump-hook nil
  "Hook run after `bookmark-jump' jumps to a bookmark.
Useful for example to unhide text in `outline-mode'.")

988 989 990
(defun bookmark--jump-via (bookmark-name-or-record display-function)
  "Handle BOOKMARK-NAME-OR-RECORD, then call DISPLAY-FUNCTION with
current buffer as argument.
Karl Fogel's avatar
Karl Fogel committed
991 992

After calling DISPLAY-FUNCTION, set window point to the point specified
993 994 995
by BOOKMARK-NAME-OR-RECORD, if necessary, run `bookmark-after-jump-hook',
and then show any annotations for this bookmark."
  (bookmark-handle-bookmark bookmark-name-or-record)
996 997 998 999 1000 1001 1002 1003 1004 1005
  (save-current-buffer
    (funcall display-function (current-buffer)))
  (let ((win (get-buffer-window (current-buffer) 0)))
    (if win (set-window-point win (point))))
  ;; FIXME: we used to only run bookmark-after-jump-hook in
  ;; `bookmark-jump' itself, but in none of the other commands.
  (run-hooks 'bookmark-after-jump-hook)
  (if bookmark-automatically-show-annotations
      ;; if there is an annotation for this bookmark,
      ;; show it in a buffer.
1006
      (bookmark-show-annotation bookmark-name-or-record)))
1007

1008

1009
;;;###autoload
1010
(defun bookmark-jump (bookmark &optional display-func)
Sam Steingold's avatar
Sam Steingold committed
1011
  "Jump to bookmark BOOKMARK (a point in some file).
Richard M. Stallman's avatar
Richard M. Stallman committed
1012 1013 1014
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
1015 1016
this.

1017
If the file pointed to by BOOKMARK no longer exists, you will be asked
1018
if you wish to give the bookmark a new location, and `bookmark-jump'
1019
will then jump to the new location, as well as recording it in place
Karl Fogel's avatar
Karl Fogel committed
1020 1021
of the old one in the permanent bookmark record.

1022 1023
BOOKMARK is usually a bookmark name (a string).  It can also be a
bookmark record, but this is usually only done by programmatic callers.
1024 1025

If DISPLAY-FUNC is non-nil, it is a function to invoke to display the
Karl Fogel's avatar