cgit.sxemacs.org Git - packages/blob - xemacs-packages/edit-utils/bookmark.el

   1 ;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later.
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 1996 Free Software Foundation
   4
   5 ;; Author: Karl Fogel <kfogel@red-bean.com>
   6 ;; Maintainer: Karl Fogel <kfogel@red-bean.com>
   7 ;; Created: July, 1993
   8 ;; Author's Update Number: see variable `bookmark-version'.
   9 ;; Keywords: bookmarks, placeholders, annotations
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; GNU Emacs is free software; you can redistribute it and/or modify
  14 ;; it under the terms of the GNU General Public License as published by
  15 ;; the Free Software Foundation; either version 2, or (at your option)
  16 ;; any later version.
  17
  18 ;; GNU Emacs is distributed in the hope that it will be useful,
  19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21 ;; GNU General Public License for more details.
  22
  23 ;; You should have received a copy of the GNU General Public License
  24 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  25 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  26 ;; Boston, MA 02111-1307, USA.
  27
  28 ;;; Commentary:
  29
  30 ;; This package is for setting "bookmarks" in files.  A bookmark
  31 ;; associates a string with a location in a certain file.  Thus, you
  32 ;; can navigate your way to that location by providing the string.
  33 ;; See the "User Variables" section for customizations.
  34
  35 ;; Thanks to David Bremner <bremner@cs.sfu.ca> for thinking of and
  36 ;; then implementing the bookmark-current-bookmark idea.  He even
  37 ;; sent *patches*, bless his soul...
  38
  39 ;; Thanks to Gregory M. Saunders <saunders@cis.ohio-state.edu> for
  40 ;; fixing and improving bookmark-time-to-save-p.
  41
  42 ;; Thanks go to Andrew V. Klein <avk@cig.mot.com> for the code that
  43 ;; sorts the alist before presenting it to the user (in bookmark-bmenu-list
  44 ;; and the menu-bar).
  45
  46 ;; And much thanks to David Hughes <djh@harston.cv.com> for many small
  47 ;; suggestions and the code to implement them (like
  48 ;; bookmark-bmenu-check-position, and some of the Lucid compatibility
  49 ;; stuff).
  50
  51 ;; Kudos (whatever they are) go to Jim Blandy <jimb@red-bean.com>
  52 ;; for his eminently sensible suggestion to separate bookmark-jump
  53 ;; into bookmark-jump and bookmark-jump-noselect, which made many
  54 ;; other things cleaner as well.
  55
  56 ;; Thanks to Roland McGrath for encouragement and help with defining
  57 ;; autoloads on the menu-bar.
  58
  59 ;; Jonathan Stigelman <stig@hackvan.com> gave patches for default
  60 ;; values in bookmark-jump and bookmark-set.  Everybody please keep
  61 ;; all the keystrokes they save thereby and send them to him at the
  62 ;; end of each year :-)  (No, seriously, thanks Jonathan!)
  63
  64 ;; Buckets of gratitude to John Grabowski <johng@media.mit.edu> for
  65 ;; thinking up the annotations feature and implementing it so well.
  66
  67 ;; Based on info-bookmark.el, by Karl Fogel and Ken Olstad
  68 ;; <olstad@msc.edu>.
  69
  70 ;; Thanks to Mikio Nakajima <PBC01764@niftyserve.or.jp> for many bugs
  71 ;; reported and fixed.
  72
  73 ;; Thank you, Michael Kifer, for contributing the XEmacs support.
  74
  75 ;; Enough with the credits already, get on to the good stuff:
  76
  77 ;; FAVORITE CHINESE RESTAURANT:
  78 ;; Boy, that's a tough one.  Probably Hong Min, or maybe Emperor's
  79 ;; Choice (both in Chicago's Chinatown).  Well, both.  How about you?
  80 \f
  81 ;;;; Code:
  82
  83 (require 'pp)
  84
  85 (defconst bookmark-version "2.6.4"
  86   "Version number of bookmark.el.  This is not related to the version
  87 of Emacs bookmark comes with; it is used solely by bookmark's
  88 maintainers to avoid version confusion.")
  89
  90 ;;; Misc comments:
  91 ;;
  92 ;; If variable bookmark-use-annotations is non-nil, an annotation is
  93 ;; queried for when setting a bookmark.
  94 ;;
  95 ;; The bookmark list is sorted lexically by default, but you can turn
  96 ;; this off by setting bookmark-sort-flag to nil.  If it is nil, then
  97 ;; the list will be presented in the order it is recorded
  98 ;; (chronologically), which is actually fairly useful as well.
  99
 100 ;;; User Variables
 101
 102 (defgroup bookmarks nil
 103   "Set bookmarks, maybe annotate them, jump to them later."
 104   :prefix "bookmark-"
 105   :group 'editing)
 106
 107
 108 (defcustom bookmark-use-annotations nil
 109   "*If non-nil, saving a bookmark will query for an annotation in a
 110 buffer."
 111   :type 'boolean
 112   :group 'bookmarks)
 113
 114
 115 (defcustom bookmark-save-flag t
 116   "*Controls when Emacs saves bookmarks to a file.
 117 --> Nil means never save bookmarks, except when `bookmark-save' is
 118     explicitly called \(\\[bookmark-save]\).
 119 --> t means save bookmarks when Emacs is killed.
 120 --> Otherwise, it should be a number that is the frequency with which
 121     the bookmark list is saved \(i.e.: the number of times which
 122     Emacs' bookmark list may be modified before it is automatically
 123     saved.\).  If it is a number, Emacs will also automatically save
 124     bookmarks when it is killed.
 125
 126 Therefore, the way to get it to save every time you make or delete a
 127 bookmark is to set this variable to 1 \(or 0, which produces the same
 128 behavior.\)
 129
 130 To specify the file in which to save them, modify the variable
 131 bookmark-default-file, which is `~/.emacs.bmk' by default."
 132   :type '(choice (const :tag "Never" nil)
 133                  (const :tag "On Exit" t)
 134                  (number :tag "Frequency" 1))
 135   :group 'bookmarks)
 136
 137
 138 (defconst bookmark-old-default-file "~/.emacs-bkmrks"
 139   "*The .emacs.bmk file used to be called this.")
 140
 141
 142 ;; defvarred to avoid a compilation warning:
 143 (defvar bookmark-file nil
 144   "Old name for `bookmark-default-file'.")
 145
 146 (defvar bookmark-default-file
 147   (if bookmark-file
 148       ;; In case user set `bookmark-file' in her .emacs:
 149       bookmark-file
 150     (convert-standard-filename "~/.emacs.bmk"))
 151   "*File in which to save bookmarks by default.")
 152
 153
 154 (defcustom bookmark-version-control 'nospecial
 155   "*Whether or not to make numbered backups of the bookmark file.
 156 It can have four values: t, nil, `never', and `nospecial'.
 157 The first three have the same meaning that they do for the
 158 variable `version-control', and the final value `nospecial' means just
 159 use the value of `version-control'."
 160   :type '(choice (const t) (const nil) (const never) (const nospecial))
 161   :group 'bookmarks)
 162
 163
 164 (defcustom bookmark-completion-ignore-case t
 165   "*Non-nil means bookmark functions ignore case in completion."
 166   :type 'boolean
 167   :group 'bookmarks)
 168
 169
 170 (defcustom bookmark-sort-flag t
 171   "*Non-nil means that bookmarks will be displayed sorted by bookmark
 172 name.  Otherwise they will be displayed in LIFO order (that is, most
 173 recently set ones come first, oldest ones come last)."
 174   :type 'boolean
 175   :group 'bookmarks)
 176
 177
 178 (defcustom bookmark-automatically-show-annotations t
 179   "*Nil means don't show annotations when jumping to a bookmark."
 180   :type 'boolean
 181   :group 'bookmarks)
 182
 183
 184 (defcustom bookmark-bmenu-file-column 30
 185   "*Column at which to display filenames in a buffer listing bookmarks.
 186 You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
 187   :type 'integer
 188   :group 'bookmarks)
 189
 190
 191 (defcustom bookmark-bmenu-toggle-filenames t
 192   "*Non-nil means show filenames when listing bookmarks.
 193 This may result in truncated bookmark names.  To disable this, put the
 194 following in your .emacs:
 195
 196 \(setq bookmark-bmenu-toggle-filenames nil\)"
 197   :type 'boolean
 198   :group 'bookmarks)
 199
 200
 201 (defcustom bookmark-menu-length 70
 202   "*Maximum length of a bookmark name displayed on a popup menu."
 203   :type 'integer
 204   :group 'bookmarks)
 205
 206
 207 ;;; No user-serviceable parts beyond this point.
 208
 209 ;; Is it XEmacs?
 210 (defconst bookmark-xemacsp
 211   (string-match "\\(Lucid\\|XEmacs\\)" emacs-version))
 212
 213
 214 ;; Added  for lucid emacs  compatibility, db
 215 (or (fboundp 'defalias)  (fset 'defalias 'fset))
 216
 217 ;; suggested for lucid compatibility by david hughes:
 218 (or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
 219
 220 ;; This variable is probably obsolete now...
 221 ;; It is. -sb
 222 ;(or (boundp 'baud-rate)
 223 ;    ;; some random value higher than 9600
 224 ;    (setq baud-rate 19200))
 225
 226 ;; XEmacs apparently call this `buffer-substring-without-properties',
 227 ;; sigh.
 228 (or (fboundp 'buffer-substring-no-properties)
 229     (if (fboundp 'buffer-substring-without-properties)
 230         (fset 'buffer-substring-no-properties
 231               'buffer-substring-without-properties)
 232       (fset 'buffer-substring-no-properties 'buffer-substring)))
 233
 234 \f
 235 ;;; Keymap stuff:
 236 ;; some people have C-x r set to rmail or whatever.  We don't want to
 237 ;; assume that C-x r is a prefix map just because it's distributed
 238 ;; that way...
 239 ;; These are the distribution keybindings suggested by RMS, everything
 240 ;; else will be done with M-x or the menubar:
 241 ;;;###autoload
 242 (if (symbolp (key-binding "\C-xr"))
 243     nil
 244   (progn (define-key ctl-x-map "rb" 'bookmark-jump)
 245          (define-key ctl-x-map "rm" 'bookmark-set)
 246          (define-key ctl-x-map "rl" 'bookmark-bmenu-list)))
 247
 248 ;; define the map, so it can be bound by those who desire to do so:
 249
 250 ;;;###autoload
 251 (defvar bookmark-map nil
 252   "Keymap containing bindings to bookmark functions.
 253 It is not bound to any key by default: to bind it
 254 so that you have a bookmark prefix, just use `global-set-key' and bind a
 255 key of your choice to `bookmark-map'.  All interactive bookmark
 256 functions have a binding in this keymap.")
 257
 258 ;;;###autoload
 259 (define-prefix-command 'bookmark-map)
 260
 261 ;; Read the help on all of these functions for details...
 262 ;;;###autoload
 263 (define-key bookmark-map "x" 'bookmark-set)
 264 ;;;###autoload
 265 (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark"
 266 ;;;###autoload
 267 (define-key bookmark-map "j" 'bookmark-jump)
 268 ;;;###autoload
 269 (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go"
 270 ;;;###autoload
 271 (define-key bookmark-map "i" 'bookmark-insert)
 272 ;;;###autoload
 273 (define-key bookmark-map "e" 'edit-bookmarks)
 274 ;;;###autoload
 275 (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find"
 276 ;;;###autoload
 277 (define-key bookmark-map "r" 'bookmark-rename)
 278 ;;;###autoload
 279 (define-key bookmark-map "d" 'bookmark-delete)
 280 ;;;###autoload
 281 (define-key bookmark-map "l" 'bookmark-load)
 282 ;;;###autoload
 283 (define-key bookmark-map "w" 'bookmark-write)
 284 ;;;###autoload
 285 (define-key bookmark-map "s" 'bookmark-save)
 286
 287
 288 ;;; The annotation maps.
 289 (defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map)
 290   "Keymap for composing an annotation for a bookmark.")
 291
 292 (define-key bookmark-read-annotation-mode-map "\C-c\C-c"
 293   'bookmark-send-annotation)
 294
 295
 296 \f
 297 ;;; Core variables and data structures:
 298 (defvar bookmark-alist ()
 299   "Association list of bookmarks and their records.
 300 You probably don't want to change the value of this alist yourself;
 301 instead, let the various bookmark functions do it for you.
 302
 303 The format of the alist is
 304
 305        \(BOOKMARK1 BOOKMARK2 ...\)
 306
 307 where each BOOKMARK is of the form
 308
 309 \(NAME
 310   \(filename . FILE\)
 311   \(front-context-string . FRONT-STR\)
 312   \(rear-context-string  . REAR-STR\)
 313   \(position . POS\)
 314   \(info-node . POS\)
 315   \(annotation . ANNOTATION\)\)
 316
 317 So the cdr of each bookmark is an alist too.
 318 `info-node' is optional, by the way.")
 319
 320
 321 (defvar bookmarks-already-loaded nil)
 322
 323
 324 ;; just add the hook to make sure that people don't lose bookmarks
 325 ;; when they kill Emacs, unless they don't want to save them.
 326 ;;;###autoload
 327 (add-hook 'kill-emacs-hook
 328           (function
 329            (lambda () (and (featurep 'bookmark)
 330                            bookmark-alist
 331                            (bookmark-time-to-save-p t)
 332                            (bookmark-save)))))
 333
 334 ;; more stuff added by db.
 335
 336 (defvar bookmark-current-bookmark nil
 337   "Name of bookmark most recently used in the current file.
 338 It is buffer local, used to make moving a bookmark forward
 339 through a file easier.")
 340
 341 (make-variable-buffer-local 'bookmark-current-bookmark)
 342
 343
 344 (defvar bookmark-alist-modification-count 0
 345   "Number of modifications to bookmark list since it was last saved.")
 346
 347
 348 (defvar bookmark-search-size 16
 349   "Length of the context strings recorded on either side of a bookmark.")
 350
 351
 352 (defvar bookmark-current-point 0)
 353 (defvar bookmark-yank-point 0)
 354 (defvar bookmark-current-buffer nil)
 355
 356
 357 \f
 358 ;; Helper functions.
 359
 360 ;; Only functions on this page and the next one (file formats) need to
 361 ;; know anything about the format of bookmark-alist entries.
 362 ;; Everyone else should go through them.
 363
 364 (defun bookmark-name-from-full-record (full-record)
 365   "Return name of FULL-RECORD \(an alist element instead of a string\)."
 366   (car full-record))
 367
 368 ;;;###autoload
 369 (defun bookmark-all-names ()
 370   "Return a list of all current bookmark names."
 371   (bookmark-maybe-load-default-file)
 372   (mapcar
 373    (lambda (full-record)
 374      (bookmark-name-from-full-record full-record))
 375    bookmark-alist))
 376
 377
 378 (defun bookmark-get-bookmark (bookmark)
 379   "Return the full entry for BOOKMARK in bookmark-alist."
 380   (assoc bookmark bookmark-alist))
 381
 382
 383 (defun bookmark-get-bookmark-record (bookmark)
 384   "Return the guts of the entry for BOOKMARK in bookmark-alist.
 385 That is, all information but the name."
 386   (car (cdr (bookmark-get-bookmark bookmark))))
 387
 388
 389 (defun bookmark-set-name (bookmark newname)
 390   "Set BOOKMARK's name to NEWNAME."
 391   (setcar (bookmark-get-bookmark bookmark) newname))
 392
 393
 394 (defun bookmark-get-annotation (bookmark)
 395   "Return the annotation of BOOKMARK, or nil if none."
 396   (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark))))
 397
 398
 399 (defun bookmark-set-annotation (bookmark ann)
 400   "Set the annotation of BOOKMARK to ANN."
 401   (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark))))
 402     (if cell
 403         (setcdr cell ann)
 404       (nconc (bookmark-get-bookmark-record bookmark)
 405              (list (cons 'annotation ann))))))
 406
 407
 408 (defun bookmark-get-filename (bookmark)
 409   "Return the full filename of BOOKMARK."
 410   (cdr (assq 'filename (bookmark-get-bookmark-record bookmark))))
 411
 412
 413 (defun bookmark-set-filename (bookmark filename)
 414   "Set the full filename of BOOKMARK to FILENAME."
 415   (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark))))
 416     (if cell
 417         (setcdr cell filename)
 418       (nconc (bookmark-get-bookmark-record bookmark)
 419              (list (cons 'filename filename))))))
 420
 421
 422 (defun bookmark-get-position (bookmark)
 423   "Return the position \(i.e.: point\) of BOOKMARK."
 424   (cdr (assq 'position (bookmark-get-bookmark-record bookmark))))
 425
 426
 427 (defun bookmark-set-position (bookmark position)
 428   "Set the position \(i.e.: point\) of BOOKMARK to POSITION."
 429   (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark))))
 430     (if cell
 431         (setcdr cell position)
 432       (nconc (bookmark-get-bookmark-record bookmark)
 433              (list (cons 'position position))))))
 434
 435
 436 (defun bookmark-get-front-context-string (bookmark)
 437   "Return the front-context-string of BOOKMARK."
 438   (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark))))
 439
 440
 441 (defun bookmark-set-front-context-string (bookmark string)
 442   "Set the front-context-string of BOOKMARK to STRING."
 443   (let ((cell (assq 'front-context-string
 444                     (bookmark-get-bookmark-record bookmark))))
 445     (if cell
 446         (setcdr cell string)
 447       (nconc (bookmark-get-bookmark-record bookmark)
 448              (list (cons 'front-context-string string))))))
 449
 450
 451 (defun bookmark-get-rear-context-string (bookmark)
 452   "Return the rear-context-string of BOOKMARK."
 453   (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark))))
 454
 455
 456 (defun bookmark-set-rear-context-string (bookmark string)
 457   "Set the rear-context-string of BOOKMARK to STRING."
 458   (let ((cell (assq 'rear-context-string
 459                     (bookmark-get-bookmark-record bookmark))))
 460     (if cell
 461         (setcdr cell string)
 462       (nconc (bookmark-get-bookmark-record bookmark)
 463              (list (cons 'rear-context-string string))))))
 464
 465
 466 (defun bookmark-get-info-node (bookmark)
 467   "Get the info node associated with BOOKMARK."
 468   (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark))))
 469
 470
 471 (defun bookmark-set-info-node (bookmark node)
 472   "Set the Info node of BOOKMARK to NODE."
 473   (let ((cell (assq 'info-node
 474                     (bookmark-get-bookmark-record bookmark))))
 475     (if cell
 476         (setcdr cell node)
 477       (nconc (bookmark-get-bookmark-record bookmark)
 478              (list (cons 'info-node node)))))
 479
 480   (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
 481   (sit-for 4)
 482   )
 483
 484
 485 (defvar bookmark-history nil
 486   "The history list for bookmark functions.")
 487
 488
 489 (defun bookmark-completing-read (prompt &optional default)
 490   "Prompting with PROMPT, read a bookmark name in completion.
 491 PROMPT will get a \": \" stuck on the end no matter what, so you
 492 probably don't want to include one yourself.
 493 Optional second arg DEFAULT is a string to return if the user enters
 494 the empty string."
 495   (bookmark-maybe-load-default-file) ; paranoia
 496   (let* ((completion-ignore-case bookmark-completion-ignore-case)
 497          (default default)
 498          (prompt (if default
 499                      (concat prompt (format " (%s): " default))
 500                    (concat prompt ": ")))
 501          (str
 502           (condition-case nil
 503               ;; XEmacs 21.2 adds the default argument.
 504               (completing-read prompt
 505                                bookmark-alist
 506                                nil
 507                                0
 508                                nil
 509                                'bookmark-history
 510                                default)
 511             (wrong-number-of-arguments
 512              (completing-read prompt
 513                               bookmark-alist
 514                               nil
 515                               0
 516                               nil
 517                               'bookmark-history)))))
 518     ;; Take care of the lack of the default argument in XEmacs 21.1.
 519     (if (string-equal "" str)
 520         (list default)
 521       (list str))))
 522
 523
 524 (defmacro bookmark-maybe-historicize-string (string)
 525   "Put STRING into the bookmark prompt history, if caller non-interactive.
 526 We need this because sometimes bookmark functions are invoked from
 527 menus, so `completing-read' never gets a chance to set `bookmark-history'."
 528   (` (or
 529       (interactive-p)
 530       (setq bookmark-history (cons (, string) bookmark-history)))))
 531
 532
 533 (defun bookmark-make (name &optional annotation overwrite info-node)
 534   "Make a bookmark named NAME.
 535 Optional second arg ANNOTATION gives it an annotation.
 536 Optional third arg OVERWRITE means replace any existing bookmarks with
 537 this name.
 538 Optional fourth arg INFO-NODE means this bookmark is at info node
 539 INFO-NODE, so record this fact in the bookmark's entry."
 540   (bookmark-maybe-load-default-file)
 541   (let ((stripped-name (copy-sequence name)))
 542     (or bookmark-xemacsp
 543         ;; XEmacs's `set-text-properties' doesn't work on
 544         ;; free-standing strings, apparently.
 545         (set-text-properties 0 (length stripped-name) nil stripped-name))
 546     (if (and (bookmark-get-bookmark stripped-name) (not overwrite))
 547         ;; already existing bookmark under that name and
 548         ;; no prefix arg means just overwrite old bookmark
 549         (setcdr (bookmark-get-bookmark stripped-name)
 550                 (list (bookmark-make-cell annotation info-node)))
 551
 552       ;; otherwise just cons it onto the front (either the bookmark
 553       ;; doesn't exist already, or there is no prefix arg.  In either
 554       ;; case, we want the new bookmark consed onto the alist...)
 555
 556       (setq bookmark-alist
 557             (cons
 558              (list stripped-name
 559                    (bookmark-make-cell annotation info-node))
 560              bookmark-alist)))
 561
 562     ;; Added by db
 563     (setq bookmark-current-bookmark stripped-name)
 564     (setq bookmark-alist-modification-count
 565           (1+ bookmark-alist-modification-count))
 566     (if (bookmark-time-to-save-p)
 567         (bookmark-save))))
 568
 569
 570 (defun bookmark-make-cell (annotation &optional info-node)
 571   "Return the record part of a new bookmark, given ANNOTATION.
 572 Must be at the correct position in the buffer in which the bookmark is
 573 being set.  This might change someday.
 574 Optional second arg INFO-NODE means this bookmark is at info node
 575 INFO-NODE, so record this fact in the bookmark's entry."
 576   (let ((the-record
 577          (` ((filename . (, (bookmark-buffer-file-name)))
 578              (front-context-string
 579               . (, (if (>= (- (point-max) (point)) bookmark-search-size)
 580                        (buffer-substring-no-properties
 581                         (point)
 582                         (+ (point) bookmark-search-size))
 583                      nil)))
 584              (rear-context-string
 585               . (, (if (>= (- (point) (point-min)) bookmark-search-size)
 586                        (buffer-substring-no-properties
 587                         (point)
 588                         (- (point) bookmark-search-size))
 589                      nil)))
 590              (position . (, (point)))
 591              ))))
 592
 593     ;; Now fill in the optional parts:
 594     (if annotation
 595         (nconc the-record (list (cons 'annotation annotation))))
 596     (if info-node
 597         (nconc the-record (list (cons 'info-node info-node))))
 598
 599     ;; Finally, return the completed record.
 600     the-record))
 601
 602
 603 \f
 604 ;;; File format stuff
 605
 606 ;; The OLD format of the bookmark-alist was:
 607 ;;
 608 ;;       ((bookmark-name (filename
 609 ;;                        string-in-front
 610 ;;                        string-behind
 611 ;;                        point))
 612 ;;        ...)
 613 ;;
 614 ;; The NEW format of the bookmark-alist is:
 615 ;;
 616 ;;       ((bookmark-name ((filename . FILENAME)
 617 ;;                        (front-context-string . string-in-front)
 618 ;;                        (rear-context-string  . string-behind)
 619 ;;                        (position . POINT)
 620 ;;                        (annotation . annotation)
 621 ;;                        (whatever   . VALUE)
 622 ;;                        ...
 623 ;;                        ))
 624 ;;        ...)
 625 ;;
 626 ;;
 627 ;; I switched to using an internal as well as external alist because I
 628 ;; felt that would be a more flexible framework in which to add
 629 ;; features.  It means that the order in which values appear doesn't
 630 ;; matter, and it means that arbitrary values can be added without
 631 ;; risk of interfering with existing ones.
 632 ;;
 633 ;; BOOKMARK-NAME is the string the user gives the bookmark and
 634 ;; accesses it by from then on.
 635 ;;
 636 ;; FILENAME is the location of the file in which the bookmark is set.
 637 ;;
 638 ;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
 639 ;; context in front of the point at which the bookmark is set.
 640 ;;
 641 ;; STRING-BEHIND is the same thing, but after the point.
 642 ;;
 643 ;; The context strings exist so that modifications to a file don't
 644 ;; necessarily cause a bookmark's position to be invalidated.
 645 ;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
 646 ;; case the file has changed since the bookmark was set.  It will
 647 ;; attempt to place the user before the changes, if there were any.
 648 ;; ANNOTATION is the annotation for the bookmark; it may not exist
 649 ;; (for backward compatibility), be nil (no annotation), or be a
 650 ;; string.
 651
 652
 653 (defconst bookmark-file-format-version 1
 654   "The current version of the format used by bookmark files.
 655 You should never need to change this.")
 656
 657
 658 (defconst bookmark-end-of-version-stamp-marker
 659   "-*- End Of Bookmark File Format Version Stamp -*-\n"
 660   "This string marks the end of the version stamp in a bookmark file.")
 661
 662
 663 (defun bookmark-alist-from-buffer ()
 664   "Return a bookmark-alist (in any format) from the current buffer.
 665 The buffer must of course contain bookmark format information.
 666 Does not care from where in the buffer it is called, and does not
 667 affect point."
 668   (save-excursion
 669     (goto-char (point-min))
 670     (if (search-forward bookmark-end-of-version-stamp-marker nil t)
 671         (read (current-buffer))
 672       ;; Else we're dealing with format version 0
 673       (if (search-forward "(" nil t)
 674           (progn
 675             (forward-char -1)
 676             (read (current-buffer)))
 677         ;; Else no hope of getting information here.
 678         (error "Not bookmark format")))))
 679
 680
 681 (defun bookmark-upgrade-version-0-alist (old-list)
 682   "Upgrade a version 0 alist OLD-LIST to the current version."
 683   (mapcar
 684    (lambda (bookmark)
 685      (let* ((name      (car bookmark))
 686             (record    (car (cdr bookmark)))
 687             (filename  (nth 0 record))
 688             (front-str (nth 1 record))
 689             (rear-str  (nth 2 record))
 690             (position  (nth 3 record))
 691             (ann       (nth 4 record)))
 692        (list
 693         name
 694         (` ((filename             .    (, filename))
 695             (front-context-string .    (, (or front-str "")))
 696             (rear-context-string  .    (, (or rear-str  "")))
 697             (position             .    (, position))
 698             (annotation           .    (, ann)))))))
 699    old-list))
 700
 701
 702 (defun bookmark-upgrade-file-format-from-0 ()
 703   "Upgrade a bookmark file of format 0 (the original format) to format 1.
 704 This expects to be called from point-min in a bookmark file."
 705   (message "Upgrading bookmark format from 0 to %d..."
 706            bookmark-file-format-version)
 707   (let* ((old-list (bookmark-alist-from-buffer))
 708          (new-list (bookmark-upgrade-version-0-alist old-list)))
 709     (delete-region (point-min) (point-max))
 710     (bookmark-insert-file-format-version-stamp)
 711     (pp new-list (current-buffer))
 712     (save-buffer))
 713   (goto-char (point-min))
 714   (message "Upgrading bookmark format from 0 to %d...done"
 715            bookmark-file-format-version)
 716   )
 717
 718
 719 (defun bookmark-grok-file-format-version ()
 720   "Return an integer which is the file-format version of this bookmark file.
 721 This expects to be called from point-min in a bookmark file."
 722   (if (looking-at "^;;;;")
 723       (save-excursion
 724         (save-match-data
 725           (re-search-forward "[0-9]")
 726           (forward-char -1)
 727           (read (current-buffer))))
 728     ;; Else this is format version 0, the original one, which didn't
 729     ;; even have version stamps.
 730     0))
 731
 732
 733 (defun bookmark-maybe-upgrade-file-format ()
 734   "Check the file-format version of this bookmark file.
 735 If the version is not up-to-date, upgrade it automatically.
 736 This expects to be called from point-min in a bookmark file."
 737   (let ((version (bookmark-grok-file-format-version)))
 738     (cond
 739      ((= version bookmark-file-format-version)
 740       ) ; home free -- version is current
 741      ((= version 0)
 742       (bookmark-upgrade-file-format-from-0))
 743      (t
 744       (error "Bookmark file format version strangeness")))))
 745
 746
 747 (defun bookmark-insert-file-format-version-stamp ()
 748   "Insert text indicating current version of bookmark file format."
 749   (insert
 750    (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
 751            bookmark-file-format-version))
 752   (insert ";;; This format is meant to be slightly human-readable;\n"
 753           ";;; nevertheless, you probably don't want to edit it.\n"
 754           ";;; "
 755           bookmark-end-of-version-stamp-marker))
 756
 757
 758 ;;; end file-format stuff
 759
 760 \f
 761 ;;; Core code:
 762
 763 ;;;###autoload
 764 (defun bookmark-set (&optional name parg)
 765   "Set a bookmark named NAME inside a file.
 766 If name is nil, then the user will be prompted.
 767 With prefix arg, will not overwrite a bookmark that has the same name
 768 as NAME if such a bookmark already exists, but instead will \"push\"
 769 the new bookmark onto the bookmark alist.  Thus the most recently set
 770 bookmark with name NAME would be the one in effect at any given time,
 771 but the others are still there, should you decide to delete the most
 772 recent one.
 773
 774 To yank words from the text of the buffer and use them as part of the
 775 bookmark name, type C-w while setting a bookmark.  Successive C-w's
 776 yank successive words.
 777
 778 Typing C-u inserts the name of the last bookmark used in the buffer
 779 \(as an aid in using a single bookmark name to track your progress
 780 through a large file\).  If no bookmark was used, then C-u inserts the
 781 name of the file being visited.
 782
 783 Use \\[bookmark-delete] to remove bookmarks \(you give it a name,
 784 and it removes only the first instance of a bookmark with that name from
 785 the list of bookmarks.\)"
 786   (interactive (list nil current-prefix-arg))
 787   (or
 788    (bookmark-buffer-file-name)
 789    (error "Buffer not visiting a file or directory"))
 790
 791   (bookmark-maybe-load-default-file)
 792
 793   (setq bookmark-current-point (point))
 794   (setq bookmark-yank-point (point))
 795   (setq bookmark-current-buffer (current-buffer))
 796
 797   (let* ((default (or bookmark-current-bookmark
 798                       (bookmark-buffer-name)))
 799          (str
 800           (or name
 801               (read-from-minibuffer
 802                (format "Set bookmark (%s): " default)
 803                nil
 804                (let ((now-map (copy-keymap minibuffer-local-map)))
 805                  (progn (define-key now-map  "\C-w"
 806              &nb