bookmark.el 87.5 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

Paul Eggert's avatar
Paul Eggert committed
3
;; Copyright (C) 1993-1997, 2001-2018 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 <https://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'."
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
(defcustom bookmark-bmenu-use-header-line t
133 134 135
  "Non-nil means to use an immovable header line.
This is as opposed to inline text at the top of the buffer."
  :version "24.4"
136 137
  :type 'boolean
  :group 'bookmark)
138

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

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

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


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

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

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

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

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


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

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

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

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

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

197 198
;;;###autoload (define-key ctl-x-r-map "b" 'bookmark-jump)
;;;###autoload (define-key ctl-x-r-map "m" 'bookmark-set)
199
;;;###autoload (define-key ctl-x-r-map "M" 'bookmark-set-no-overwrite)
200
;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)
201

202
;;;###autoload
203 204 205 206 207
(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
208
    (define-key map "M" 'bookmark-set-no-overwrite) ;"M"aybe mark
209 210 211 212 213 214 215 216 217 218 219 220
    (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
221 222 223 224
  "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
225 226
functions have a binding in this keymap.")

227
;;;###autoload (fset 'bookmark-map bookmark-map)
228 229 230


;;; Core variables and data structures:
231
(defvar bookmark-alist ()
232
  "Association list of bookmark names and their parameters.
233 234
Bookmark functions update the value automatically.
You probably do NOT want to change the value yourself.
235

236
The value is an alist with entries of the form
237

238
 (BOOKMARK-NAME . PARAM-ALIST)
239

240
or the deprecated form (BOOKMARK-NAME PARAM-ALIST).
241

242
 BOOKMARK-NAME is the name you gave to the bookmark when creating it.
243

244 245 246 247
 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.
248

249
  (filename . FILENAME)
250
  (position . POS)
251 252 253 254 255 256
  (front-context-string . STR-AFTER-POS)
  (rear-context-string  . STR-BEFORE-POS)
  (handler . HANDLER)
  (annotation . ANNOTATION)

 FILENAME names the bookmarked file.
257
 POS is the bookmarked buffer position.
258 259 260 261 262 263 264
 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,
265
 for instance.  HANDLER must accept a bookmark as its single argument.")
266

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

270 271
(defvar bookmark-file-coding-system nil
  "The coding-system of the last loaded or saved bookmark file.")
272

Richard M. Stallman's avatar
Richard M. Stallman committed
273
;; more stuff added by db.
274

Sam Steingold's avatar
Sam Steingold committed
275
(defvar bookmark-current-bookmark nil
Richard M. Stallman's avatar
Richard M. Stallman committed
276 277
  "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
278
through a file easier.")
Richard M. Stallman's avatar
Richard M. Stallman committed
279 280 281

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

282

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

286 287

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

290

Karl Fogel's avatar
Karl Fogel committed
291 292 293
(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
294 295
the source buffer for that information; see `bookmark-yank-word'
for example.")
Karl Fogel's avatar
Karl Fogel committed
296 297 298 299


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

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

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

320
(defun bookmark-name-from-full-record (bookmark-record)
321 322 323
  "Return the name of BOOKMARK-RECORD.  BOOKMARK-RECORD is, e.g.,
one element from `bookmark-alist'."
  (car bookmark-record))
324 325 326 327 328


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


332 333 334 335 336 337
(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."
338
  (cond
339 340 341 342 343 344 345 346 347 348 349 350
   ((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))))
351 352 353 354
    ;; The bookmark objects can either look like (NAME ALIST) or
    ;; (NAME . ALIST), so we have to distinguish the two here.
    (if (and (null (cdr alist)) (consp (caar alist)))
        (car alist) alist)))
355 356


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

361 362 363
(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))))
364

365 366 367 368
(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))))
369 370
    (if cell
        (setcdr cell val)
371
      (nconc (bookmark-get-bookmark-record bookmark-name-or-record)
372
             (list (cons prop val))))))
373

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

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


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


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


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


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


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


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


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


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


423 424 425
(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))
426

427 428 429 430
(defvar bookmark-history nil
  "The history list for bookmark functions.")


431 432 433 434
(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.
435 436
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."
437
  (bookmark-maybe-load-default-file) ; paranoia
438
  (if (listp last-nonmenu-event)
439 440 441 442 443
      (bookmark-menu-popup-paned-menu t prompt
				      (if bookmark-sort-flag
					  (sort (bookmark-all-names)
						'string-lessp)
					(bookmark-all-names)))
444
    (let* ((completion-ignore-case bookmark-completion-ignore-case)
445
           (default (unless (equal "" default) default))
446 447
	   (prompt (concat prompt (if default
                                      (format " (%s): " default)
448 449 450 451 452 453 454 455
                                    ": "))))
      (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))))
456 457


458 459 460 461
(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
462
  `(or
463
    (called-interactively-p 'interactive)
Sam Steingold's avatar
Sam Steingold committed
464
    (setq bookmark-history (cons ,string bookmark-history))))
465

466
(defvar bookmark-make-record-function 'bookmark-make-record-default
467 468 469 470
  "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.
471

472
The function will be called with no arguments.
473 474
It should signal a user error if it is unable to construct a record for
the current location.
475 476 477

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
478 479 480
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.
481 482

NAME is a suggested name for the constructed bookmark.  It can be nil
483 484
in which case a default heuristic will be used.  The function can also
equivalently just return ALIST without NAME.")
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)))
489 490 491 492
    ;; Set up default name if the function does not provide one.
    (unless (stringp (car record))
      (if (car record) (push nil record))
      (setcar record (or bookmark-current-bookmark (bookmark-buffer-name))))
493 494 495 496 497
    ;; Set up defaults.
    (bookmark-prop-set
     record 'defaults
     (delq nil (delete-dups (append (bookmark-prop-get record 'defaults)
				    (list bookmark-current-bookmark
498 499 500
					  (car record)
                                          (bookmark-buffer-name))))))
    record))
501 502 503 504 505 506

(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."
507
  (bookmark-maybe-load-default-file)
508
  (let ((stripped-name (copy-sequence name)))
Dan Nicolaescu's avatar
Dan Nicolaescu committed
509
    (or (featurep 'xemacs)
510 511 512
        ;; XEmacs's `set-text-properties' doesn't work on
        ;; free-standing strings, apparently.
        (set-text-properties 0 (length stripped-name) nil stripped-name))
513 514
    (if (and (not no-overwrite)
             (bookmark-get-bookmark stripped-name 'noerror))
515
        ;; already existing bookmark under that name and
516
        ;; no prefix arg means just overwrite old bookmark
517 518
        ;; Use the new (NAME . ALIST) format.
        (setcdr (bookmark-get-bookmark stripped-name) alist)
Sam Steingold's avatar
Sam Steingold committed
519

520 521 522
      ;; 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
523

524
      (push (cons stripped-name alist) bookmark-alist))
Sam Steingold's avatar
Sam Steingold committed
525

526 527 528 529 530
    ;; 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)
531
        (bookmark-save))
532

533 534
    (setq bookmark-current-bookmark stripped-name)
    (bookmark-bmenu-surreptitiously-rebuild-list)))
535

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

567 568 569

;;; File format stuff

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


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


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


(defun bookmark-upgrade-file-format-from-0 ()
  "Upgrade a bookmark file of format 0 (the original format) to format 1.
688
This expects to be called from `point-min' in a bookmark file."
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))
694
    (bookmark-insert-file-format-version-stamp buffer-file-coding-system)
695 696 697
    (pp new-list (current-buffer))
    (save-buffer))
  (goto-char (point-min))
698
  (message "Upgrading bookmark format from 0 to %d...done"
699 700 701 702 703 704
           bookmark-file-format-version)
  )


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


731 732 733 734 735
(defun bookmark-insert-file-format-version-stamp (coding)
  "Insert text indicating current version of bookmark file format.
CODING is the symbol of the coding-system in which the file is encoded."
  (if (memq (coding-system-base coding) '(undecided prefer-utf-8))
      (setq coding 'utf-8-emacs))
736
  (insert
737 738
   (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*- \n"
           bookmark-file-format-version (coding-system-base coding)))
739 740 741 742 743 744 745 746
  (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

747 748 749 750 751 752 753 754

;;; 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)))

755 756 757

;;; Core code:

Stefan Monnier's avatar
Stefan Monnier committed
758 759 760 761 762 763
(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))

764 765 766 767 768 769 770 771 772 773 774 775 776
(defun bookmark-set-internal (prompt name overwrite-or-push)
  "Interactively set a bookmark named NAME at the current location.

Begin the interactive prompt with PROMPT, followed by a space, a
generated default name in parentheses, a colon and a space.

If OVERWRITE-OR-PUSH is nil, then error if there is already a
bookmark named NAME; if `overwrite', then replace any existing
bookmark if there is one; if `push' then push the new bookmark
onto the bookmark alist.  The `push' behavior means that among
bookmarks named NAME, this most recently set one becomes the one in
effect, but the others are still there, in order, if the topmost one
is ever deleted."
777
  (interactive (list nil current-prefix-arg))
778 779
  (unwind-protect
       (let* ((record (bookmark-make-record))
780 781 782 783 784 785 786 787 788 789 790 791 792
              ;; `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))
793 794 795 796 797 798 799 800 801 802 803 804

         (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
805
                     (format "%s (default \"%s\"): " prompt default)
806 807
                     nil
                     bookmark-minibuffer-read-name-map
808
                     nil nil defaults))))
809
           (and (string-equal str "") (setq str default))
810 811 812 813 814 815 816 817 818 819 820 821 822

           (cond
            ((eq overwrite-or-push nil)
             (if (bookmark-get-bookmark str t)
                 (error "A bookmark named \"%s\" already exists." str)
               (bookmark-store str (cdr record) nil)))
            ((eq overwrite-or-push 'overwrite)
             (bookmark-store str (cdr record) nil))
            ((eq overwrite-or-push 'push)
             (bookmark-store str (cdr record) t))
            (t
             (error "Unrecognized value for `overwrite-or-push': %S"
                    overwrite-or-push)))
823 824 825 826 827 828 829

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

830

831
;;;###autoload
832 833 834 835 836 837 838 839 840 841 842 843 844 845 846 847 848 849 850 851 852 853 854 855 856 857 858 859 860
(defun bookmark-set (&optional name no-overwrite)
  "Set a bookmark named NAME at the current location.
If NAME is nil, then prompt the user.

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.

To yank words from the text of the buffer and use them as part of the
bookmark name, type C-w while setting a bookmark.  Successive C-w's
yank successive words.

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.

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.)"
  (interactive (list nil current-prefix-arg))
  (let ((prompt
         (if no-overwrite "Set bookmark" "Set bookmark unconditionally")))
    (bookmark-set-internal prompt name (if no-overwrite 'push 'overwrite))))

861
;;;###autoload
862 863 864 865 866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881 882 883 884 885 886 887 888 889 890 891 892
(defun bookmark-set-no-overwrite (&optional name push-bookmark)
  "Set a bookmark named NAME at the current location.
If NAME is nil, then prompt the user.

If a bookmark named NAME already exists and prefix argument
PUSH-BOOKMARK is non-nil, then push the new bookmark onto the
bookmark alist.  Pushing it means that among bookmarks named
NAME, this one becomes the one in effect, but the others are
still there, in order, and become effective again if the user
ever deletes the most recent one.

Otherwise, if a bookmark named NAME already exists but PUSH-BOOKMARK
is nil, raise an error.

To yank words from the text of the buffer and use them as part of the
bookmark name, type C-w while setting a bookmark.  Successive C-w's
yank successive words.

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.

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.)"
  (interactive (list nil current-prefix-arg))
  (bookmark-set-internal "Set bookmark" name (if push-bookmark 'push nil)))


893 894 895
(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.
896
Does not affect the kill ring."
897
  (let ((eol (line-end-position)))
898
    (delete-region (point) eol)
899 900
    (when (and newline-too (= (following-char) ?\n))
      (delete-char 1))))
901 902


903
;; Defvars to avoid compilation warnings:
904 905 906 907
(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.")
908 909


910 911
(defun bookmark-default-annotation-text (bookmark-name)
  "Return default annotation text for BOOKMARK-NAME.
Karl Fogel's avatar
Karl Fogel committed
912 913
The default annotation text is simply some text explaining how to use
annotations."
914
  (concat (format-message
915
           "#  Type the annotation for bookmark `%s' here.\n"
916 917
           bookmark-name)
	  (format-message
918
           "#  All lines which start with a `#' will be deleted.\n")
919 920 921 922 923 924
	  "#  Type C-c C-c when done.\n#\n"
	  "#  Author: " (user-full-name) " <" (user-login-name) "@"
	  (system-name) ">\n"
	  "#  Date:    " (current-time-string) "\n"))


925 926
(define-obsolete-variable-alias 'bookmark-read-annotation-text-func
  'bookmark-edit-annotation-text-func "23.1")
927
(defvar bookmark-edit-annotation-text-func 'bookmark-default-annotation-text
928
  "Function to return default text to use for a bookmark annotation.
929
It takes one argument, the name of the bookmark, as a string.")
930

931 932 933 934 935
(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)
936 937
  "Keymap for editing an annotation of a bookmark.")

938
(defun bookmark-insert-annotation (bookmark-name-or-record)
939 940
  (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record))
  (let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
941
    (if (and annotation (not (string-equal annotation "")))
942 943 944 945 946 947 948 949
	(insert annotation))))

(define-derived-mode bookmark-edit-annotation-mode
  text-mode "Edit Bookmark Annotation"
  "Mode for editing the annotation of bookmarks.
When you have finished composing, type \\[bookmark-send-annotation].

\\{bookmark-edit-annotation-mode-map}")
950 951 952


(defun bookmark-send-edited-annotation ()
953 954
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
955
  (interactive)
956
  (if (not (derived-mode-p 'bookmark-edit-annotation-mode))
957
      (error "Not in bookmark-edit-annotation-mode"))