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

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

;; This file is part of GNU Emacs.

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

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

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

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

Erik Naggum's avatar
Erik Naggum committed
34
(require 'pp)
Stefan Monnier's avatar
Stefan Monnier committed
35
(eval-when-compile (require 'cl-lib))
Erik Naggum's avatar
Erik Naggum committed
36

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

47 48
;;; User Variables

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


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


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

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

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


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


Paul Eggert's avatar
Paul Eggert committed
85
;; defvared to avoid a compilation warning:
86 87 88
(defvar bookmark-file nil
  "Old name for `bookmark-default-file'.")

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


99
(defcustom bookmark-version-control 'nospecial
Stefan Monnier's avatar
Stefan Monnier committed
100
  "Whether or not to make numbered backups of the bookmark file.
101
It can have four values: t, nil, `never', or `nospecial'.
102
The first three have the same meaning that they do for the
103 104 105 106
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)
107 108
                 (const :tag "Use value of option `version-control'" nospecial)
                 (other :tag "Always" t))
109
  :group 'bookmark)
110 111


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


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


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

131
(defcustom bookmark-bmenu-use-header-line t
132 133 134
  "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"
135 136
  :type 'boolean
  :group 'bookmark)
137

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

143
(defconst bookmark-bmenu-marks-width 2
144 145
  "Number of columns (chars) used for the *Bookmark List* marks column.
This includes 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
    (define-key map "j" 'bookmark-jump)
    (define-key map "g" 'bookmark-jump) ;"g"o
    (define-key map "o" 'bookmark-jump-other-window)
212
    (define-key map "5" 'bookmark-jump-other-frame)
213 214 215 216 217 218 219 220 221
    (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
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
225
key of your choice to variable `bookmark-map'.  All interactive bookmark
Richard M. Stallman's avatar
Richard M. Stallman committed
226 227
functions have a binding in this keymap.")

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

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

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

239
 (BOOKMARK-NAME . PARAM-ALIST)
240

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

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

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

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

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

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

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

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

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

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

283

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

287 288

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

291

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


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

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

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

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


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


333 334 335 336
(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
337 338 339
error.  If optional argument NOERROR is non-nil, return nil
instead of signaling an error.  Else if BOOKMARK-NAME-OR-RECORD
is already a bookmark record, just return it."
340
  (cond
341 342 343 344 345 346 347 348 349
   ((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)
350 351
  "Return the record portion of BOOKMARK-NAME-OR-RECORD in `bookmark-alist'.
In other words, return all information but the name."
352
  (let ((alist (cdr (bookmark-get-bookmark bookmark-name-or-record))))
353 354 355 356
    ;; 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)))
357 358


359 360 361
(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))
362

363 364 365
(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))))
366

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

376 377 378
(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))
379

380 381 382
(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))
383 384


385 386 387
(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))
388 389


390 391 392
(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))
393 394


395 396 397
(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))
398 399


400 401 402
(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))
403 404


405 406 407
(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))
408 409


410 411 412
(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))
413 414


415 416 417
(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))
418 419


420 421 422
(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))
423 424


425 426 427
(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))
428

429 430 431 432
(defvar bookmark-history nil
  "The history list for bookmark functions.")


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


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

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

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

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
480 481 482
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.
483 484

NAME is a suggested name for the constructed bookmark.  It can be nil
485 486
in which case a default heuristic will be used.  The function can also
equivalently just return ALIST without NAME.")
487 488 489 490

(defun bookmark-make-record ()
  "Return a new bookmark record (NAME . ALIST) for the current location."
  (let ((record (funcall bookmark-make-record-function)))
491 492 493 494
    ;; 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))))
495 496 497 498 499
    ;; Set up defaults.
    (bookmark-prop-set
     record 'defaults
     (delq nil (delete-dups (append (bookmark-prop-get record 'defaults)
				    (list bookmark-current-bookmark
500 501 502
					  (car record)
                                          (bookmark-buffer-name))))))
    record))
503 504 505 506 507 508

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

522 523 524
      ;; 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
525

526
      (push (cons stripped-name alist) bookmark-alist))
Sam Steingold's avatar
Sam Steingold committed
527

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

535 536
    (setq bookmark-current-bookmark stripped-name)
    (bookmark-bmenu-surreptitiously-rebuild-list)))
537

538
(defun bookmark-make-record-default (&optional no-file no-context posn)
539
  "Return the record describing the location of a new bookmark.
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 566 567
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
568

569 570 571

;;; File format stuff

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


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


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


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


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


733 734 735 736 737
(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))
738
  (insert
739
   (format ";;;; Emacs Bookmark Format Version %d ;;;; -*- coding: %S -*-\n"
740
           bookmark-file-format-version (coding-system-base coding)))
741 742 743 744 745 746 747 748
  (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

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

757 758 759

;;; Core code:

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

766 767 768 769 770 771 772 773 774 775 776 777 778
(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."
779
  (interactive (list nil current-prefix-arg))
780 781
  (unwind-protect
       (let* ((record (bookmark-make-record))
782 783 784 785 786 787 788 789 790 791 792 793 794
              ;; `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))
795 796 797 798 799 800 801 802 803 804 805 806

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

           (cond
            ((eq overwrite-or-push nil)
             (if (bookmark-get-bookmark str t)
816
                 (error "A bookmark named \"%s\" already exists" str)
817 818 819 820 821 822 823 824
               (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)))
825 826 827 828 829 830 831

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

832

833
;;;###autoload
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 861 862
(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))))

863
;;;###autoload
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 893 894
(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)))


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


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


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


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

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

940
(defun bookmark-insert-annotation (bookmark-name-or-record)
941
  "Insert annotation for BOOKMARK-NAME-OR-RECORD at point."
942 943
  (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record))
  (let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
944
    (if (and annotation (not (string-equal annotation "")))
945 946 947 948 949 950 951 952
	(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}")
953 954 955


(defun bookmark-send-edited-annotation ()
956 957
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
958
  (interactive)
959
  (if (not (derived-mode-p 'bookmark-edit-annotation-mode))
960
      (error "Not in bookmark-edit-annotation-mode"))
961 962
  (goto-char (point-min))
  (while (< (point) (point-max))
963
    (if (= (following-char) ?#)
964 965
        (bookmark-kill-line t)
      (forward-line 1)))
Stefan Monnier's avatar
Stefan Monnier committed
966 967
  ;; Take no chances with text properties.
  (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
968 969
	(bookmark-name bookmark-annotation-name))
    (bookmark-set-annotation bookmark-name annotation)
970 971
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
Karl Fogel's avatar
Karl Fogel committed
972
    (bookmark-bmenu-surreptitiously-rebuild-list))
973 974 975
  (kill-buffer (current-buffer)))