bookmark.el 83.6 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-2013 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)
Stefan Monnier's avatar
Stefan Monnier committed
36
(eval-when-compile (require 'cl-lib))
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's 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


Paul Eggert's avatar
Paul Eggert committed
86
;; defvared to avoid a compilation warning:
87 88 89
(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
It can have four values: t, nil, `never', or `nospecial'.
103
The first three have the same meaning that they do for the
104 105 106 107
variable `version-control'; the value `nospecial' (the default) means
just use the value of `version-control'."
  :type '(choice (const :tag "If existing" nil)
                 (const :tag "Never" never)
108 109
                 (const :tag "Use value of option `version-control'" nospecial)
                 (other :tag "Always" t))
110
  :group 'bookmark)
111 112


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


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


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

132 133 134 135 136
(defcustom bookmark-bmenu-use-header-line t
  "Non-nil means to use an immovable header line, as opposed to inline
text at the top of the buffer."
  :type 'boolean
  :group 'bookmark)
137

138 139 140
(defconst bookmark-bmenu-inline-header-height 2
  "Number of lines used for the *Bookmark List* header
\(only significant when `bookmark-bmenu-use-header-line' is nil\).")
141

142 143 144
(defconst bookmark-bmenu-marks-width 2
  "Number of columns (chars) used for the *Bookmark List* marks column,
including the annotations column.")
145

146
(defcustom bookmark-bmenu-file-column 30
Stefan Monnier's avatar
Stefan Monnier committed
147
  "Column at which to display filenames in a buffer listing bookmarks.
148 149 150
You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
  :type 'integer
  :group 'bookmark)
151 152


153
(defcustom bookmark-bmenu-toggle-filenames t
Stefan Monnier's avatar
Stefan Monnier committed
154
  "Non-nil means show filenames when listing bookmarks.
155
A non-nil value may result in truncated bookmark names."
156 157
  :type 'boolean
  :group 'bookmark)
158

159 160 161 162
(defface bookmark-menu-bookmark
  '((t (:weight bold)))
  "Face used to highlight bookmark names in bookmark menu buffers."
  :group 'bookmark)
163

164
(defcustom bookmark-menu-length 70
Stefan Monnier's avatar
Stefan Monnier committed
165
  "Maximum length of a bookmark name displayed on a popup menu."
166
  :type 'integer
167
  :group 'bookmark)
168

169
;; FIXME: Is it really worth a customization option?
170
(defcustom bookmark-search-delay 0.2
171
  "Time before `bookmark-bmenu-search' updates the display."
172
  :group 'bookmark
173
  :type  'number)
174

175 176 177 178 179 180 181
(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")


182
;;; No user-serviceable parts beyond this point.
Richard M. Stallman's avatar
Richard M. Stallman committed
183 184 185 186

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

187
;; suggested for lucid compatibility by david hughes:
188
(or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
189

190 191

;;; Keymap stuff:
Richard M. Stallman's avatar
Richard M. Stallman committed
192

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

196 197 198
;;;###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)
199

200
;;;###autoload
201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217
(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
218 219 220 221
  "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
222 223
functions have a binding in this keymap.")

224
;;;###autoload (fset 'bookmark-map bookmark-map)
225 226 227


;;; Core variables and data structures:
228
(defvar bookmark-alist ()
229
  "Association list of bookmarks and their records.
230 231
Bookmark functions update the value automatically.
You probably do NOT want to change the value yourself.
232

233
The value is an alist with entries of the form
234

235
 (BOOKMARK-NAME . PARAM-ALIST)
236

237
or the deprecated form (BOOKMARK-NAME PARAM-ALIST).
238

239
 BOOKMARK-NAME is the name you gave to the bookmark when creating it.
240

241 242 243 244
 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.
245

246
  (filename . FILENAME)
247
  (position . POS)
248 249 250 251 252 253 254 255 256 257 258 259 260 261 262
  (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.")
263

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

267

Richard M. Stallman's avatar
Richard M. Stallman committed
268
;; more stuff added by db.
269

Sam Steingold's avatar
Sam Steingold committed
270
(defvar bookmark-current-bookmark nil
Richard M. Stallman's avatar
Richard M. Stallman committed
271 272
  "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
273
through a file easier.")
Richard M. Stallman's avatar
Richard M. Stallman committed
274 275 276

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

277

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

281 282

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

285

Karl Fogel's avatar
Karl Fogel committed
286 287 288
(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
289 290
the source buffer for that information; see `bookmark-yank-word'
for example.")
Karl Fogel's avatar
Karl Fogel committed
291 292 293 294


(defvar bookmark-yank-point 0
  "The next point from which to pull source text for `bookmark-yank-word'.
295
This point is in `bookmark-current-buffer'.")
Karl Fogel's avatar
Karl Fogel committed
296

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

298 299
(defvar bookmark-quit-flag nil
  "Non nil make `bookmark-bmenu-search' quit immediately.")
300

301 302 303 304 305 306 307 308 309 310 311 312
;; 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.
313 314
;; Everyone else should go through them.

315
(defun bookmark-name-from-full-record (bookmark-record)
316 317 318
  "Return the name of BOOKMARK-RECORD.  BOOKMARK-RECORD is, e.g.,
one element from `bookmark-alist'."
  (car bookmark-record))
319 320 321 322 323


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


327 328 329 330 331 332
(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."
333
  (cond
334 335 336 337 338 339 340 341 342 343 344 345
   ((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))))
346 347 348 349
    ;; 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)))
350 351


352 353 354
(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))
355

356 357 358
(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))))
359

360 361 362 363
(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))))
364 365
    (if cell
        (setcdr cell val)
366
      (nconc (bookmark-get-bookmark-record bookmark-name-or-record)
367
             (list (cons prop val))))))
368

369 370 371
(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))
372

373 374 375
(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))
376 377


378 379 380
(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))
381 382


383 384 385
(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))
386 387


388 389 390
(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))
391 392


393 394 395
(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))
396 397


398 399 400
(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))
401 402


403 404 405
(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))
406 407


408 409 410
(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))
411 412


413 414 415
(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))
416 417


418 419 420
(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))
421

422 423 424 425
(defvar bookmark-history nil
  "The history list for bookmark functions.")


426 427 428 429
(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.
430 431
Optional arg DEFAULT is a string to return if the user input is empty.
If DEFAULT is nil then return empty string for empty input."
432
  (bookmark-maybe-load-default-file) ; paranoia
433
  (if (listp last-nonmenu-event)
434 435 436 437 438
      (bookmark-menu-popup-paned-menu t prompt
				      (if bookmark-sort-flag
					  (sort (bookmark-all-names)
						'string-lessp)
					(bookmark-all-names)))
439
    (let* ((completion-ignore-case bookmark-completion-ignore-case)
440
           (default (unless (equal "" default) default))
441 442
	   (prompt (concat prompt (if default
                                      (format " (%s): " default)
443 444 445 446 447 448 449 450
                                    ": "))))
      (completing-read prompt
                       (lambda (string pred action)
                         (if (eq action 'metadata)
                             '(metadata (category . bookmark))
                             (complete-with-action
                              action bookmark-alist string pred)))
                       nil 0 nil 'bookmark-history default))))
451 452


453 454 455 456
(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
457
  `(or
458
    (called-interactively-p 'interactive)
Sam Steingold's avatar
Sam Steingold committed
459
    (setq bookmark-history (cons ,string bookmark-history))))
460

461
(defvar bookmark-make-record-function 'bookmark-make-record-default
462 463 464 465
  "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.
466

467
The function will be called with no arguments.
468 469
It should signal a user error if it is unable to construct a record for
the current location.
470 471 472

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
473 474 475
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.
476 477

NAME is a suggested name for the constructed bookmark.  It can be nil
478 479
in which case a default heuristic will be used.  The function can also
equivalently just return ALIST without NAME.")
480 481 482 483

(defun bookmark-make-record ()
  "Return a new bookmark record (NAME . ALIST) for the current location."
  (let ((record (funcall bookmark-make-record-function)))
484 485 486 487 488 489
    ;; Set up defaults.
    (bookmark-prop-set
     record 'defaults
     (delq nil (delete-dups (append (bookmark-prop-get record 'defaults)
				    (list bookmark-current-bookmark
					  (bookmark-buffer-name))))))
490 491 492 493 494 495 496 497 498 499 500 501 502
    ;; 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."
503
  (bookmark-maybe-load-default-file)
504
  (let ((stripped-name (copy-sequence name)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
505
    (or (featurep 'xemacs)
506 507 508
        ;; XEmacs's `set-text-properties' doesn't work on
        ;; free-standing strings, apparently.
        (set-text-properties 0 (length stripped-name) nil stripped-name))
509 510
    (if (and (not no-overwrite)
             (bookmark-get-bookmark stripped-name 'noerror))
511
        ;; already existing bookmark under that name and
512
        ;; no prefix arg means just overwrite old bookmark
513 514
        ;; Use the new (NAME . ALIST) format.
        (setcdr (bookmark-get-bookmark stripped-name) alist)
Sam Steingold's avatar
Sam Steingold committed
515

516 517 518
      ;; 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
519

520
      (push (cons stripped-name alist) bookmark-alist))
Sam Steingold's avatar
Sam Steingold committed
521

522 523 524 525 526
    ;; 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)
527
        (bookmark-save))
528

529 530
    (setq bookmark-current-bookmark stripped-name)
    (bookmark-bmenu-surreptitiously-rebuild-list)))
531

532
(defun bookmark-make-record-default (&optional no-file no-context posn)
533
  "Return the record describing the location of a new bookmark.
534 535 536 537 538 539 540 541 542 543 544 545 546 547 548 549 550 551 552 553 554 555 556 557 558 559 560 561
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
562

563 564 565

;;; File format stuff

566 567 568 569 570 571 572 573 574 575
;; *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:
576
;;
577
;;       ((BOOKMARK-NAME (FILENAME
578 579 580
;;                          STRING-IN-FRONT
;;                          STRING-BEHIND
;;                          POINT))
581 582
;;        ...)
;;
583 584 585 586 587 588 589 590 591 592 593 594 595
;; 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:
596
;;
597
;;       ((BOOKMARK-NAME (filename   . FILENAME)
598 599 600
;;                       (position   . POS)
;;                       (front-context-string . STR-AFTER-POS)
;;                       (rear-context-string  . STR-BEFORE-POS)
601 602 603
;;                       (annotation . ANNOTATION)
;;                       (whatever   . VALUE)
;;                       ...
604
;;                       )
605 606
;;        ...)
;;
607 608 609 610 611 612 613 614
;; 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.
615
;;
616 617 618 619 620
;; 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.)
621
;;
622 623 624
;; 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'.
625
;;
626 627
;; No conversion from SECOND to CURRENT is done.  Instead, the code
;; handles both formats OK.  It must continue to do so.
628
;;
629 630
;; See the doc string of `bookmark-alist' for information about the
;; elements that define a bookmark (e.g. `filename').
631 632 633 634 635 636 637 638 639 640 641 642 643


(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 ()
644
  "Return a `bookmark-alist' (in any format) from the current buffer.
645 646 647 648 649 650 651 652 653 654 655 656 657
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.
658
        (error "Not bookmark format")))))
659 660 661


(defun bookmark-upgrade-version-0-alist (old-list)
662
  "Upgrade a version 0 alist OLD-LIST to the current version."
663 664 665 666 667 668 669 670 671 672 673
  (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
674 675 676 677 678
        `((filename             .    ,filename)
          (front-context-string .    ,(or front-str ""))
          (rear-context-string  .    ,(or rear-str  ""))
          (position             .    ,position)
          (annotation           .    ,ann)))))
679 680 681 682 683
   old-list))


(defun bookmark-upgrade-file-format-from-0 ()
  "Upgrade a bookmark file of format 0 (the original format) to format 1.
684
This expects to be called from `point-min' in a bookmark file."
685 686 687 688 689 690 691 692 693
  (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))
694
  (message "Upgrading bookmark format from 0 to %d...done"
695 696 697 698 699 700
           bookmark-file-format-version)
  )


(defun bookmark-grok-file-format-version ()
  "Return an integer which is the file-format version of this bookmark file.
701
This expects to be called from `point-min' in a bookmark file."
702 703 704 705 706 707 708 709 710 711 712 713 714 715
  (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.
716
This expects to be called from `point-min' in a bookmark file."
717 718 719 720 721 722 723
  (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
724
      (error "Bookmark file format version strangeness")))))
725 726 727


(defun bookmark-insert-file-format-version-stamp ()
728
  "Insert text indicating current version of bookmark file format."
729 730 731 732 733 734 735 736 737 738 739
  (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

740 741 742 743 744 745 746 747

;;; 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)))

748 749 750

;;; Core code:

Stefan Monnier's avatar
Stefan Monnier committed
751 752 753 754 755 756
(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)
    map))

757
;;;###autoload
Karl Fogel's avatar
Karl Fogel committed
758
(defun bookmark-set (&optional name no-overwrite)
759
  "Set a bookmark named NAME at the current location.
Karl Fogel's avatar
Karl Fogel committed
760 761
If name is nil, then prompt the user.

762 763 764 765 766 767
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
768 769

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

773 774 775 776 777
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
778

779
Use \\[bookmark-delete] to remove bookmarks (you give it a name and
780
it removes only the first instance of a bookmark with that name from
781
the list of bookmarks.)"
782
  (interactive (list nil current-prefix-arg))
783 784
  (unwind-protect
       (let* ((record (bookmark-make-record))
785 786 787 788 789 790 791 792 793 794 795 796 797
              ;; `defaults' is a transient element of the
              ;; extensible format described above in the section
              ;; `File format stuff'.  Bookmark record functions
              ;; can use it to specify a list of default values
              ;; accessible via M-n while reading a bookmark name.
              (defaults (bookmark-prop-get record 'defaults))
              (default (if (consp defaults) (car defaults) defaults)))

         (if defaults
             ;; Don't store default values in the record.
             (setq record (assq-delete-all 'defaults record))
           ;; When no defaults in the record, use its first element.
           (setq defaults (car record) default defaults))
798 799 800 801 802 803 804 805 806 807 808 809 810 811 812

         (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
813
                     nil nil defaults))))
814 815 816 817 818 819 820 821 822
           (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)))

823 824 825 826

(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.
827
Does not affect the kill ring."
828
  (let ((eol (line-end-position)))
829 830 831 832 833
    (delete-region (point) eol)
    (if (and newline-too (looking-at "\n"))
        (delete-char 1))))


834
;; Defvars to avoid compilation warnings:
835 836 837 838
(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.")
839 840


841 842
(defun bookmark-default-annotation-text (bookmark-name)
  "Return default annotation text for BOOKMARK-NAME.
Karl Fogel's avatar
Karl Fogel committed
843 844
The default annotation text is simply some text explaining how to use
annotations."
845
  (concat "#  Type the annotation for bookmark '" bookmark-name "' here.\n"
846 847 848 849 850 851 852
	  "#  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"))


853 854
(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
  'bookmark-edit-annotation-text-func "23.1")
855
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
856
  "Function to return default text to use for a bookmark annotation.
857
It takes one argument, the name of the bookmark, as a string.")
858

859 860 861 862 863
(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)
864 865 866
  "Keymap for editing an annotation of a bookmark.")


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

871
\\{bookmark-edit-annotation-mode-map}"
872 873 874
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'bookmark-annotation-name)
875
  (setq bookmark-annotation-name bookmark-name-or-record)
876
  (use-local-map bookmark-edit-annotation-mode-map)
877 878
  (setq major-mode 'bookmark-edit-annotation-mode
        mode-name "Edit Bookmark Annotation")
879 880
  (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record))
  (let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
881
    (if (and annotation (not (string-equal annotation "")))
882
	(insert annotation)))
883
  (run-mode-hooks 'text-mode-hook))
884 885 886


(defun bookmark-send-edited-annotation ()
887 888
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
889 890
  (interactive)
  (if (not (eq major-mode 'bookmark-edit-annotation-mode))
891
      (error "Not in bookmark-edit-annotation-mode"))
892 893 894 895 896
  (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
897 898
  ;; Take no chances with text properties.
  (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
899 900
	(bookmark-name bookmark-annotation-name))
    (bookmark-set-annotation bookmark-name annotation)
901 902
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
Karl Fogel's avatar
Karl Fogel committed
903
    (bookmark-bmenu-surreptitiously-rebuild-list))
904 905 906
  (kill-buffer (current-buffer)))


907 908
(defun bookmark-edit-annotation (bookmark-name-or-record)
  "Pop up a buffer for editing bookmark BOOKMARK-NAME-OR-RECORD's annotation."
909
  (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
910
  (bookmark-edit-annotation-mode bookmark-name-or-record))
911

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

913
(defun bookmark-buffer-name ()
914 915
  "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."
916 917 918 919 920 921 922 923 924 925 926 927 928 929 930 931 932 933 934
  (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
935
(defun bookmark-yank-word ()
Karl Fogel's avatar
Karl Fogel committed
936 937
  "Get the next word from buffer `bookmark-current-buffer' and append
it to the name of the bookmark currently being set, advancing
938
`bookmark-yank-point' by one word."
Richard M. Stallman's avatar
Richard M. Stallman committed
939
  (interactive)