code.delx.au - gnu-emacs/blob - lisp/bookmark.el

   1 ;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
   2
   3 ;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
   4 ;;   2004, 2005 Free Software Foundation, Inc.
   5
   6 ;; Author: Karl Fogel <kfogel@red-bean.com>
   7 ;; Maintainer: Karl Fogel <kfogel@red-bean.com>
   8 ;; Created: July, 1993
   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., 51 Franklin Street, Fifth Floor,
  26 ;; Boston, MA 02110-1301, 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 ;;; Misc comments:
  86 ;;
  87 ;; If variable bookmark-use-annotations is non-nil, an annotation is
  88 ;; queried for when setting a bookmark.
  89 ;;
  90 ;; The bookmark list is sorted lexically by default, but you can turn
  91 ;; this off by setting bookmark-sort-flag to nil.  If it is nil, then
  92 ;; the list will be presented in the order it is recorded
  93 ;; (chronologically), which is actually fairly useful as well.
  94
  95 ;;; User Variables
  96
  97 (defgroup bookmark nil
  98   "Setting, annotation and jumping to bookmarks."
  99   :group 'matching)
 100
 101
 102 (defcustom bookmark-use-annotations nil
 103   "*If non-nil, saving a bookmark queries for an annotation in a buffer."
 104   :type 'boolean
 105   :group 'bookmark)
 106
 107
 108 (defcustom bookmark-save-flag t
 109   "*Controls when Emacs saves bookmarks to a file.
 110 --> nil means never save bookmarks, except when `bookmark-save' is
 111     explicitly called \(\\[bookmark-save]\).
 112 --> t means save bookmarks when Emacs is killed.
 113 --> Otherwise, it should be a number that is the frequency with which
 114     the bookmark list is saved \(i.e.: the number of times which
 115     Emacs' bookmark list may be modified before it is automatically
 116     saved.\).  If it is a number, Emacs will also automatically save
 117     bookmarks when it is killed.
 118
 119 Therefore, the way to get it to save every time you make or delete a
 120 bookmark is to set this variable to 1 \(or 0, which produces the same
 121 behavior.\)
 122
 123 To specify the file in which to save them, modify the variable
 124 `bookmark-default-file', which is `~/.emacs.bmk' by default."
 125   :type '(choice (const nil) integer (other t))
 126   :group 'bookmark)
 127
 128
 129 (defconst bookmark-old-default-file "~/.emacs-bkmrks"
 130   "*The `.emacs.bmk' file used to be called this name.")
 131
 132
 133 ;; defvarred to avoid a compilation warning:
 134 (defvar bookmark-file nil
 135   "Old name for `bookmark-default-file'.")
 136
 137 (defcustom bookmark-default-file
 138   (if bookmark-file
 139       ;; In case user set `bookmark-file' in her .emacs:
 140       bookmark-file
 141     (convert-standard-filename "~/.emacs.bmk"))
 142   "*File in which to save bookmarks by default."
 143   :type 'file
 144   :group 'bookmark)
 145
 146
 147 (defcustom bookmark-version-control 'nospecial
 148   "*Whether or not to make numbered backups of the bookmark file.
 149 It can have four values: t, nil, `never', and `nospecial'.
 150 The first three have the same meaning that they do for the
 151 variable `version-control', and the final value `nospecial' means just
 152 use the value of `version-control'."
 153   :type '(choice (const nil) (const never) (const nospecial)
 154                  (other t))
 155   :group 'bookmark)
 156
 157
 158 (defcustom bookmark-completion-ignore-case t
 159   "*Non-nil means bookmark functions ignore case in completion."
 160   :type 'boolean
 161   :group 'bookmark)
 162
 163
 164 (defcustom bookmark-sort-flag t
 165   "*Non-nil means that bookmarks will be displayed sorted by bookmark name.
 166 Otherwise they will be displayed in LIFO order (that is, most
 167 recently set ones come first, oldest ones come last)."
 168   :type 'boolean
 169   :group 'bookmark)
 170
 171
 172 (defcustom bookmark-automatically-show-annotations t
 173   "*Non-nil means show annotations when jumping to a bookmark."
 174   :type 'boolean
 175   :group 'bookmark)
 176
 177
 178 (defcustom bookmark-bmenu-file-column 30
 179   "*Column at which to display filenames in a buffer listing bookmarks.
 180 You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
 181   :type 'integer
 182   :group 'bookmark)
 183
 184
 185 (defcustom bookmark-bmenu-toggle-filenames t
 186   "*Non-nil means show filenames when listing bookmarks.
 187 This may result in truncated bookmark names.  To disable this, put the
 188 following in your `.emacs' file:
 189
 190 \(setq bookmark-bmenu-toggle-filenames nil\)"
 191   :type 'boolean
 192   :group 'bookmark)
 193
 194
 195 (defcustom bookmark-menu-length 70
 196   "*Maximum length of a bookmark name displayed on a popup menu."
 197   :type 'integer
 198   :group 'bookmark)
 199
 200
 201 ;;; No user-serviceable parts beyond this point.
 202
 203 ;; Is it XEmacs?
 204 (defconst bookmark-xemacsp
 205   (string-match "\\(Lucid\\|Xemacs\\)" emacs-version))
 206
 207
 208 ;; Added  for lucid emacs  compatibility, db
 209 (or (fboundp 'defalias)  (fset 'defalias 'fset))
 210
 211 ;; suggested for lucid compatibility by david hughes:
 212 (or (fboundp 'frame-height)  (defalias 'frame-height 'screen-height))
 213
 214 ;; This variable is probably obsolete now...
 215 (or (boundp 'baud-rate)
 216     ;; some random value higher than 9600
 217     (setq baud-rate 19200))
 218
 219
 220 \f
 221 ;;; Keymap stuff:
 222
 223 ;; Set up these bindings dumping time *only*;
 224 ;; if the user alters them, don't override the user when loading bookmark.el.
 225
 226 ;;;###autoload (define-key ctl-x-map "rb" 'bookmark-jump)
 227 ;;;###autoload (define-key ctl-x-map "rm" 'bookmark-set)
 228 ;;;###autoload (define-key ctl-x-map "rl" 'bookmark-bmenu-list)
 229
 230 ;;;###autoload
 231 (defvar bookmark-map nil
 232   "Keymap containing bindings to bookmark functions.
 233 It is not bound to any key by default: to bind it
 234 so that you have a bookmark prefix, just use `global-set-key' and bind a
 235 key of your choice to `bookmark-map'.  All interactive bookmark
 236 functions have a binding in this keymap.")
 237
 238 ;;;###autoload (define-prefix-command 'bookmark-map)
 239
 240 ;; Read the help on all of these functions for details...
 241 ;;;###autoload (define-key bookmark-map "x" 'bookmark-set)
 242 ;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark"
 243 ;;;###autoload (define-key bookmark-map "j" 'bookmark-jump)
 244 ;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go"
 245 ;;;###autoload (define-key bookmark-map "i" 'bookmark-insert)
 246 ;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks)
 247 ;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find"
 248 ;;;###autoload (define-key bookmark-map "r" 'bookmark-rename)
 249 ;;;###autoload (define-key bookmark-map "d" 'bookmark-delete)
 250 ;;;###autoload (define-key bookmark-map "l" 'bookmark-load)
 251 ;;;###autoload (define-key bookmark-map "w" 'bookmark-write)
 252 ;;;###autoload (define-key bookmark-map "s" 'bookmark-save)
 253
 254
 255 ;;; The annotation maps.
 256 (defvar bookmark-read-annotation-mode-map (copy-keymap text-mode-map)
 257   "Keymap for composing an annotation for a bookmark.")
 258
 259 (define-key bookmark-read-annotation-mode-map "\C-c\C-c"
 260   'bookmark-send-annotation)
 261
 262
 263 \f
 264 ;;; Core variables and data structures:
 265 (defvar bookmark-alist ()
 266   "Association list of bookmarks and their records.
 267 You probably don't want to change the value of this alist yourself;
 268 instead, let the various bookmark functions do it for you.
 269
 270 The format of the alist is
 271
 272        \(BOOKMARK1 BOOKMARK2 ...\)
 273
 274 where each BOOKMARK is of the form
 275
 276 \(NAME
 277   \(filename . FILE\)
 278   \(front-context-string . FRONT-STR\)
 279   \(rear-context-string  . REAR-STR\)
 280   \(position . POS\)
 281   \(info-node . POS\)
 282   \(annotation . ANNOTATION\)\)
 283
 284 So the cdr of each bookmark is an alist too.
 285 `info-node' is optional, by the way.")
 286
 287
 288 (defvar bookmarks-already-loaded nil)
 289
 290
 291 ;; more stuff added by db.
 292
 293 (defvar bookmark-current-bookmark nil
 294   "Name of bookmark most recently used in the current file.
 295 It is buffer local, used to make moving a bookmark forward
 296 through a file easier.")
 297
 298 (make-variable-buffer-local 'bookmark-current-bookmark)
 299
 300
 301 (defvar bookmark-alist-modification-count 0
 302   "Number of modifications to bookmark list since it was last saved.")
 303
 304
 305 (defvar bookmark-search-size 16
 306   "Length of the context strings recorded on either side of a bookmark.")
 307
 308
 309 (defvar bookmark-current-point 0)
 310 (defvar bookmark-yank-point 0)
 311 (defvar bookmark-current-buffer nil)
 312
 313 (defvar Info-current-node)
 314 (defvar Info-suffix-list)
 315 \f
 316 ;; Helper functions.
 317
 318 ;; Only functions on this page and the next one (file formats) need to
 319 ;; know anything about the format of bookmark-alist entries.
 320 ;; Everyone else should go through them.
 321
 322 (defun bookmark-name-from-full-record (full-record)
 323   "Return name of FULL-RECORD \(an alist element instead of a string\)."
 324   (car full-record))
 325
 326
 327 (defun bookmark-all-names ()
 328   "Return a list of all current bookmark names."
 329   (bookmark-maybe-load-default-file)
 330   (mapcar
 331    (lambda (full-record)
 332      (bookmark-name-from-full-record full-record))
 333    bookmark-alist))
 334
 335
 336 (defun bookmark-get-bookmark (bookmark)
 337   "Return the full entry for BOOKMARK in `bookmark-alist'.
 338 If BOOKMARK is not a string, return nil."
 339   (when (stringp bookmark)
 340     (assoc-string bookmark bookmark-alist bookmark-completion-ignore-case)))
 341
 342
 343 (defun bookmark-get-bookmark-record (bookmark)
 344   "Return the guts of the entry for BOOKMARK in `bookmark-alist'.
 345 That is, all information but the name."
 346   (car (cdr (bookmark-get-bookmark bookmark))))
 347
 348
 349 (defun bookmark-set-name (bookmark newname)
 350   "Set BOOKMARK's name to NEWNAME."
 351   (setcar
 352    (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
 353    newname))
 354
 355
 356 (defun bookmark-get-annotation (bookmark)
 357   "Return the annotation of BOOKMARK, or nil if none."
 358   (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark))))
 359
 360
 361 (defun bookmark-set-annotation (bookmark ann)
 362   "Set the annotation of BOOKMARK to ANN."
 363   (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark))))
 364     (if cell
 365         (setcdr cell ann)
 366       (nconc (bookmark-get-bookmark-record bookmark)
 367              (list (cons 'annotation ann))))))
 368
 369
 370 (defun bookmark-get-filename (bookmark)
 371   "Return the full filename of BOOKMARK."
 372   (cdr (assq 'filename (bookmark-get-bookmark-record bookmark))))
 373
 374
 375 (defun bookmark-set-filename (bookmark filename)
 376   "Set the full filename of BOOKMARK to FILENAME."
 377   (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark))))
 378     (if cell
 379         (setcdr cell filename)
 380       (nconc (bookmark-get-bookmark-record bookmark)
 381              (list (cons 'filename filename))))
 382     (setq bookmark-alist-modification-count
 383           (1+ bookmark-alist-modification-count))
 384     (if (bookmark-time-to-save-p)
 385         (bookmark-save))))
 386
 387
 388 (defun bookmark-get-position (bookmark)
 389   "Return the position \(i.e.: point\) of BOOKMARK."
 390   (cdr (assq 'position (bookmark-get-bookmark-record bookmark))))
 391
 392
 393 (defun bookmark-set-position (bookmark position)
 394   "Set the position \(i.e.: point\) of BOOKMARK to POSITION."
 395   (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark))))
 396     (if cell
 397         (setcdr cell position)
 398       (nconc (bookmark-get-bookmark-record bookmark)
 399              (list (cons 'position position))))))
 400
 401
 402 (defun bookmark-get-front-context-string (bookmark)
 403   "Return the front-context-string of BOOKMARK."
 404   (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark))))
 405
 406
 407 (defun bookmark-set-front-context-string (bookmark string)
 408   "Set the front-context-string of BOOKMARK to STRING."
 409   (let ((cell (assq 'front-context-string
 410                     (bookmark-get-bookmark-record bookmark))))
 411     (if cell
 412         (setcdr cell string)
 413       (nconc (bookmark-get-bookmark-record bookmark)
 414              (list (cons 'front-context-string string))))))
 415
 416
 417 (defun bookmark-get-rear-context-string (bookmark)
 418   "Return the rear-context-string of BOOKMARK."
 419   (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark))))
 420
 421
 422 (defun bookmark-set-rear-context-string (bookmark string)
 423   "Set the rear-context-string of BOOKMARK to STRING."
 424   (let ((cell (assq 'rear-context-string
 425                     (bookmark-get-bookmark-record bookmark))))
 426     (if cell
 427         (setcdr cell string)
 428       (nconc (bookmark-get-bookmark-record bookmark)
 429              (list (cons 'rear-context-string string))))))
 430
 431
 432 (defun bookmark-get-info-node (bookmark)
 433   "Get the info node associated with BOOKMARK."
 434   (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark))))
 435
 436
 437 (defun bookmark-set-info-node (bookmark node)
 438   "Set the Info node of BOOKMARK to NODE."
 439   (let ((cell (assq 'info-node
 440                     (bookmark-get-bookmark-record bookmark))))
 441     (if cell
 442         (setcdr cell node)
 443       (nconc (bookmark-get-bookmark-record bookmark)
 444              (list (cons 'info-node node)))))
 445
 446   (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
 447   (sit-for 4))
 448
 449
 450 (defvar bookmark-history nil
 451   "The history list for bookmark functions.")
 452
 453
 454 (defun bookmark-completing-read (prompt &optional default)
 455   "Prompting with PROMPT, read a bookmark name in completion.
 456 PROMPT will get a \": \" stuck on the end no matter what, so you
 457 probably don't want to include one yourself.
 458 Optional second arg DEFAULT is a string to return if the user enters
 459 the empty string."
 460   (bookmark-maybe-load-default-file) ; paranoia
 461   (if (listp last-nonmenu-event)
 462       (bookmark-menu-popup-paned-menu t prompt (bookmark-all-names))
 463     (let* ((completion-ignore-case bookmark-completion-ignore-case)
 464            (default default)
 465            (prompt (if default
 466                        (concat prompt (format " (%s): " default))
 467                      (concat prompt ": ")))
 468            (str
 469             (completing-read prompt
 470                              bookmark-alist
 471                              nil
 472                              0
 473                              nil
 474                              'bookmark-history)))
 475       (if (string-equal "" str) default str))))
 476
 477
 478 (defmacro bookmark-maybe-historicize-string (string)
 479   "Put STRING into the bookmark prompt history, if caller non-interactive.
 480 We need this because sometimes bookmark functions are invoked from
 481 menus, so `completing-read' never gets a chance to set `bookmark-history'."
 482   `(or
 483     (interactive-p)
 484     (setq bookmark-history (cons ,string bookmark-history))))
 485
 486
 487 (defun bookmark-make (name &optional annotation overwrite info-node)
 488   "Make a bookmark named NAME.
 489 Optional second arg ANNOTATION gives it an annotation.
 490 Optional third arg OVERWRITE means replace any existing bookmarks with
 491 this name.
 492 Optional fourth arg INFO-NODE means this bookmark is at info node
 493 INFO-NODE, so record this fact in the bookmark's entry."
 494   (bookmark-maybe-load-default-file)
 495   (let ((stripped-name (copy-sequence name)))
 496     (or bookmark-xemacsp
 497         ;; XEmacs's `set-text-properties' doesn't work on
 498         ;; free-standing strings, apparently.
 499         (set-text-properties 0 (length stripped-name) nil stripped-name))
 500     (if (and (bookmark-get-bookmark stripped-name) (not overwrite))
 501         ;; already existing bookmark under that name and
 502         ;; no prefix arg means just overwrite old bookmark
 503         (setcdr (bookmark-get-bookmark stripped-name)
 504                 (list (bookmark-make-cell annotation info-node)))
 505
 506       ;; otherwise just cons it onto the front (either the bookmark
 507       ;; doesn't exist already, or there is no prefix arg.  In either
 508       ;; case, we want the new bookmark consed onto the alist...)
 509
 510       (setq bookmark-alist
 511             (cons
 512              (list stripped-name
 513                    (bookmark-make-cell annotation info-node))
 514              bookmark-alist)))
 515
 516     ;; Added by db
 517     (setq bookmark-current-bookmark stripped-name)
 518     (setq bookmark-alist-modification-count
 519           (1+ bookmark-alist-modification-count))
 520     (if (bookmark-time-to-save-p)
 521         (bookmark-save))))
 522
 523
 524 (defun bookmark-make-cell (annotation &optional info-node)
 525   "Return the record part of a new bookmark, given ANNOTATION.
 526 Must be at the correct position in the buffer in which the bookmark is
 527 being set.  This might change someday.
 528 Optional second arg INFO-NODE means this bookmark is at info node
 529 INFO-NODE, so record this fact in the bookmark's entry."
 530   (let ((the-record
 531          `((filename . ,(bookmark-buffer-file-name))
 532            (front-context-string
 533             . ,(if (>= (- (point-max) (point)) bookmark-search-size)
 534                    (buffer-substring-no-properties
 535                     (point)
 536                     (+ (point) bookmark-search-size))
 537                    nil))
 538            (rear-context-string
 539             . ,(if (>= (- (point) (point-min)) bookmark-search-size)
 540                    (buffer-substring-no-properties
 541                     (point)
 542                     (- (point) bookmark-search-size))
 543                    nil))
 544            (position . ,(point)))))
 545
 546     ;; Now fill in the optional parts:
 547
 548     ;; Take no chances with text properties
 549     (set-text-properties 0 (length annotation) nil annotation)
 550     (set-text-properties 0 (length info-node) nil info-node)
 551
 552     (if annotation
 553         (nconc the-record (list (cons 'annotation annotation))))
 554     (if info-node
 555         (nconc the-record (list (cons 'info-node info-node))))
 556
 557     ;; Finally, return the completed record.
 558     the-record))
 559
 560
 561 \f
 562 ;;; File format stuff
 563
 564 ;; The OLD format of the bookmark-alist was:
 565 ;;
 566 ;;       ((bookmark-name (filename
 567 ;;                        string-in-front
 568 ;;                        string-behind
 569 ;;                        point))
 570 ;;        ...)
 571 ;;
 572 ;; The NEW format of the bookmark-alist is:
 573 ;;
 574 ;;       ((bookmark-name ((filename . FILENAME)
 575 ;;                        (front-context-string . string-in-front)
 576 ;;                        (rear-context-string  . string-behind)
 577 ;;                        (position . POINT)
 578 ;;                        (annotation . annotation)
 579 ;;                        (whatever   . VALUE)
 580 ;;                        ...
 581 ;;                        ))
 582 ;;        ...)
 583 ;;
 584 ;;
 585 ;; I switched to using an internal as well as external alist because I
 586 ;; felt that would be a more flexible framework in which to add
 587 ;; features.  It means that the order in which values appear doesn't
 588 ;; matter, and it means that arbitrary values can be added without
 589 ;; risk of interfering with existing ones.
 590 ;;
 591 ;; BOOKMARK-NAME is the string the user gives the bookmark and
 592 ;; accesses it by from then on.
 593 ;;
 594 ;; FILENAME is the location of the file in which the bookmark is set.
 595 ;;
 596 ;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
 597 ;; context in front of the point at which the bookmark is set.
 598 ;;
 599 ;; STRING-BEHIND is the same thing, but after the point.
 600 ;;
 601 ;; The context strings exist so that modifications to a file don't
 602 ;; necessarily cause a bookmark's position to be invalidated.
 603 ;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
 604 ;; case the file has changed since the bookmark was set.  It will
 605 ;; attempt to place the user before the changes, if there were any.
 606 ;; ANNOTATION is the annotation for the bookmark; it may not exist
 607 ;; (for backward compatibility), be nil (no annotation), or be a
 608 ;; string.
 609
 610
 611 (defconst bookmark-file-format-version 1
 612   "The current version of the format used by bookmark files.
 613 You should never need to change this.")
 614
 615
 616 (defconst bookmark-end-of-version-stamp-marker
 617   "-*- End Of Bookmark File Format Version Stamp -*-\n"
 618   "This string marks the end of the version stamp in a bookmark file.")
 619
 620
 621 (defun bookmark-alist-from-buffer ()
 622   "Return a `bookmark-alist' (in any format) from the current buffer.
 623 The buffer must of course contain bookmark format information.
 624 Does not care from where in the buffer it is called, and does not
 625 affect point."
 626   (save-excursion
 627     (goto-char (point-min))
 628     (if (search-forward bookmark-end-of-version-stamp-marker nil t)
 629         (read (current-buffer))
 630       ;; Else we're dealing with format version 0
 631       (if (search-forward "(" nil t)
 632           (progn
 633             (forward-char -1)
 634             (read (current-buffer)))
 635         ;; Else no hope of getting information here.
 636         (error "Not bookmark format")))))
 637
 638
 639 (defun bookmark-upgrade-version-0-alist (old-list)
 640   "Upgrade a version 0 alist OLD-LIST to the current version."
 641   (mapcar
 642    (lambda (bookmark)
 643      (let* ((name      (car bookmark))
 644             (record    (car (cdr bookmark)))
 645             (filename  (nth 0 record))
 646             (front-str (nth 1 record))
 647             (rear-str  (nth 2 record))
 648             (position  (nth 3 record))
 649             (ann       (nth 4 record)))
 650        (list
 651         name
 652         `((filename             .    ,filename)
 653           (front-context-string .    ,(or front-str ""))
 654           (rear-context-string  .    ,(or rear-str  ""))
 655           (position             .    ,position)
 656           (annotation           .    ,ann)))))
 657    old-list))
 658
 659
 660 (defun bookmark-upgrade-file-format-from-0 ()
 661   "Upgrade a bookmark file of format 0 (the original format) to format 1.
 662 This expects to be called from `point-min' in a bookmark file."
 663   (message "Upgrading bookmark format from 0 to %d..."
 664            bookmark-file-format-version)
 665   (let* ((old-list (bookmark-alist-from-buffer))
 666          (new-list (bookmark-upgrade-version-0-alist old-list)))
 667     (delete-region (point-min) (point-max))
 668     (bookmark-insert-file-format-version-stamp)
 669     (pp new-list (current-buffer))
 670     (save-buffer))
 671   (goto-char (point-min))
 672   (message "Upgrading bookmark format from 0 to %d...done"
 673            bookmark-file-format-version)
 674   )
 675
 676
 677 (defun bookmark-grok-file-format-version ()
 678   "Return an integer which is the file-format version of this bookmark file.
 679 This expects to be called from `point-min' in a bookmark file."
 680   (if (looking-at "^;;;;")
 681       (save-excursion
 682         (save-match-data
 683           (re-search-forward "[0-9]")
 684           (forward-char -1)
 685           (read (current-buffer))))
 686     ;; Else this is format version 0, the original one, which didn't
 687     ;; even have version stamps.
 688     0))
 689
 690
 691 (defun bookmark-maybe-upgrade-file-format ()
 692   "Check the file-format version of this bookmark file.
 693 If the version is not up-to-date, upgrade it automatically.
 694 This expects to be called from `point-min' in a bookmark file."
 695   (let ((version (bookmark-grok-file-format-version)))
 696     (cond
 697      ((= version bookmark-file-format-version)
 698       ) ; home free -- version is current
 699      ((= version 0)
 700       (bookmark-upgrade-file-format-from-0))
 701      (t
 702       (error "Bookmark file format version strangeness")))))
 703
 704
 705 (defun bookmark-insert-file-format-version-stamp ()
 706   "Insert text indicating current version of bookmark file format."
 707   (insert
 708    (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
 709            bookmark-file-format-version))
 710   (insert ";;; This format is meant to be slightly human-readable;\n"
 711           ";;; nevertheless, you probably don't want to edit it.\n"
 712           ";;; "
 713           bookmark-end-of-version-stamp-marker))
 714
 715
 716 ;;; end file-format stuff
 717
 718 \f
 719 ;;; Core code:
 720
 721 ;;;###autoload
 722 (defun bookmark-set (&optional name parg)
 723   "Set a bookmark named NAME inside a file.
 724 If name is nil, then the user will be prompted.
 725 With prefix arg, will not overwrite a bookmark that has the same name
 726 as NAME if such a bookmark already exists, but instead will \"push\"
 727 the new bookmark onto the bookmark alist.  Thus the most recently set
 728 bookmark with name NAME would be the one in effect at any given time,
 729 but the others are still there, should you decide to delete the most
 730 recent one.
 731
 732 To yank words from the text of the buffer and use them as part of the
 733 bookmark name, type C-w while setting a bookmark.  Successive C-w's
 734 yank successive words.
 735
 736 Typing C-u inserts the name of the last bookmark used in the buffer
 737 \(as an aid in using a single bookmark name to track your progress
 738 through a large file\).  If no bookmark was used, then C-u inserts the
 739 name of the file being visited.
 740
 741 Use \\[bookmark-delete] to remove bookmarks \(you give it a name,
 742 and it removes only the first instance of a bookmark with that name from
 743 the list of bookmarks.\)"
 744   (interactive (list nil current-prefix-arg))
 745   (or
 746    (bookmark-buffer-file-name)
 747    (error "Buffer not visiting a file or directory"))
 748
 749   (bookmark-maybe-load-default-file)
 750
 751   (setq bookmark-current-point (point))
 752   (setq bookmark-yank-point (point))
 753   (setq bookmark-current-buffer (current-buffer))
 754
 755   (let* ((default (or bookmark-current-bookmark
 756                       (bookmark-buffer-name)))
 757          (str
 758           (or name
 759               (read-from-minibuffer
 760                (format "Set bookmark (%s): " default)
 761                nil
 762                (let ((now-map (copy-keymap minibuffer-local-map)))
 763                  (define-key now-map "\C-w" 'bookmark-yank-word)
 764                  (define-key now-map "\C-u" 'bookmark-insert-current-bookmark)
 765                  now-map))))
 766          (annotation nil))
 767     (and (string-equal str "") (setq str default))
 768     ;; Ask for an annotation buffer for this bookmark
 769     (if bookmark-use-annotations
 770         (bookmark-read-annotation parg str)
 771       (bookmark-make str annotation parg (bookmark-info-current-node))
 772       (setq bookmark-current-bookmark str)
 773       (bookmark-bmenu-surreptitiously-rebuild-list)
 774       (goto-char bookmark-current-point))))
 775
 776
 777 (defun bookmark-info-current-node ()
 778   "If in Info-mode, return current node name (a string), else nil."
 779   (if (eq major-mode 'Info-mode)
 780       Info-current-node))
 781
 782
 783 (defun bookmark-kill-line (&optional newline-too)
 784   "Kill from point to end of line.
 785 If optional arg NEWLINE-TOO is non-nil, delete the newline too.
 786 Does not affect the kill ring."
 787   (let ((eol (save-excursion (end-of-line) (point))))
 788     (delete-region (point) eol)
 789     (if (and newline-too (looking-at "\n"))
 790         (delete-char 1))))
 791
 792
 793 ;; Defvars to avoid compilation warnings:
 794 (defvar bookmark-annotation-paragraph nil)
 795 (defvar bookmark-annotation-name nil)
 796 (defvar bookmark-annotation-buffer nil)
 797 (defvar bookmark-annotation-file nil)
 798 (defvar bookmark-annotation-point nil)
 799
 800
 801 (defun bookmark-send-annotation ()
 802   "Use buffer contents as the annotation for a bookmark.
 803 Exclude lines that begin with `#'.
 804 Store the annotation text in the bookmark list with
 805 the bookmark (and file, and point) specified in buffer local variables."
 806   (interactive)
 807   (if (not (eq major-mode 'bookmark-read-annotation-mode))
 808       (error "Not in bookmark-read-annotation-mode"))
 809   (goto-char (point-min))
 810   (while (< (point) (point-max))
 811     (if (looking-at "^#")
 812         (bookmark-kill-line t)
 813       (forward-line 1)))
 814   (let ((annotation (buffer-string))
 815         (parg bookmark-annotation-paragraph)
 816         (bookmark bookmark-annotation-name)
 817         (pt bookmark-annotation-point)
 818         (buf bookmark-annotation-buffer))
 819     ;; for bookmark-make-cell to work, we need to be
 820     ;; in the relevant buffer, at the relevant point.
 821     ;; Actually, bookmark-make-cell should probably be re-written,
 822     ;; to avoid this need.  Should I handle the error if a buffer is
 823     ;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
 824     (save-excursion
 825       (pop-to-buffer buf)
 826       (goto-char pt)
 827       (bookmark-make bookmark annotation parg (bookmark-info-current-node))
 828       (setq bookmark-current-bookmark bookmark))
 829     (bookmark-bmenu-surreptitiously-rebuild-list)
 830     (goto-char bookmark-current-point))
 831   (kill-buffer (current-buffer)))
 832
 833
 834 (defun bookmark-default-annotation-text (bookmark)
 835   (concat "#  Type the annotation for bookmark '" bookmark "' here.\n"
 836           "#  All lines which start with a '#' will be deleted.\n"
 837           "#  Type C-c C-c when done.\n#\n"
 838           "#  Author: " (user-full-name) " <" (user-login-name) "@"
 839           (system-name) ">\n"
 840           "#  Date:    " (current-time-string) "\n"))
 841
 842
 843 (defvar bookmark-read-annotation-text-func 'bookmark-default-annotation-text
 844   "Function to return default text to use for a bookmark annotation.
 845 It takes one argument, the name of the bookmark, as a string.")
 846
 847 (defun bookmark-read-annotation-mode (buf point parg bookmark)
 848   "Mode for composing annotations for a bookmark.
 849 Wants BUF, POINT, PARG, and BOOKMARK.
 850 When you have finished composing, type \\[bookmark-send-annotation] to send
 851 the annotation.
 852
 853 \\{bookmark-read-annotation-mode-map}
 854 "
 855   (interactive)
 856   (kill-all-local-variables)
 857   (make-local-variable 'bookmark-annotation-paragraph)
 858   (make-local-variable 'bookmark-annotation-name)
 859   (make-local-variable 'bookmark-annotation-buffer)
 860   (make-local-variable 'bookmark-annotation-file)
 861   (make-local-variable 'bookmark-annotation-point)
 862   (setq bookmark-annotation-paragraph parg)
 863   (setq bookmark-annotation-name bookmark)
 864   (setq bookmark-annotation-buffer buf)
 865   (setq bookmark-annotation-file (buffer-file-name buf))
 866   (setq bookmark-annotation-point point)
 867   (use-local-map bookmark-read-annotation-mode-map)
 868   (setq major-mode 'bookmark-read-annotation-mode)
 869   (insert (funcall bookmark-read-annotation-text-func bookmark))
 870   (run-mode-hooks 'text-mode-hook))
 871
 872
 873 (defun bookmark-read-annotation (parg bookmark)
 874   "Pop up a buffer for entering a bookmark annotation.
 875 Text surrounding the bookmark is PARG; the bookmark name is BOOKMARK."
 876   (let ((buf (current-buffer))
 877         (point (point)))
 878     (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
 879     (bookmark-read-annotation-mode buf point parg bookmark)))
 880
 881
 882 (defvar bookmark-edit-annotation-mode-map (copy-keymap text-mode-map)
 883   "Keymap for editing an annotation of a bookmark.")
 884
 885
 886 (define-key bookmark-edit-annotation-mode-map "\C-c\C-c"
 887   'bookmark-send-edited-annotation)
 888
 889
 890 (defun bookmark-edit-annotation-mode (bookmark)
 891   "Mode for editing the annotation of bookmark BOOKMARK.
 892 When you have finished composing, type \\[bookmark-send-annotation].
 893
 894 \\{bookmark-edit-annotation-mode-map}
 895 "
 896   (interactive)
 897   (kill-all-local-variables)
 898   (make-local-variable 'bookmark-annotation-name)
 899   (setq bookmark-annotation-name bookmark)
 900   (use-local-map bookmark-edit-annotation-mode-map)
 901   (setq major-mode 'bookmark-edit-annotation-mode
 902         mode-name "Edit Bookmark Annotation")
 903   (insert (funcall bookmark-read-annotation-text-func bookmark))
 904   (let ((annotation (bookmark-get-annotation bookmark)))
 905     (if (and annotation (not (string-equal annotation "")))
 906         (insert annotation)))
 907   (run-mode-hooks 'text-mode-hook))
 908
 909
 910 (defun bookmark-send-edited-annotation ()
 911   "Use buffer contents as annotation for a bookmark.
 912 Lines beginning with `#' are ignored."
 913   (interactive)
 914   (if (not (eq major-mode 'bookmark-edit-annotation-mode))
 915       (error "Not in bookmark-edit-annotation-mode"))
 916   (goto-char (point-min))
 917   (while (< (point) (point-max))
 918     (if (looking-at "^#")
 919         (bookmark-kill-line t)
 920       (forward-line 1)))
 921   (let ((annotation (buffer-string))
 922         (bookmark bookmark-annotation-name))
 923     (bookmark-set-annotation bookmark annotation)
 924     (bookmark-bmenu-surreptitiously-rebuild-list)
 925     (goto-char bookmark-current-point))
 926   (kill-buffer (current-buffer)))
 927
 928
 929 (defun bookmark-edit-annotation (bookmark)
 930   "Pop up a buffer for editing bookmark BOOKMARK's annotation."
 931   (pop-to-buffer (generate-new-buffer-name "*Bookmark Annotation Compose*"))
 932   (bookmark-edit-annotation-mode bookmark))
 933
 934
 935 (defun bookmark-insert-current-bookmark ()
 936   "Insert this buffer's value of `bookmark-current-bookmark'.
 937 Default to file name if it's nil."
 938   (interactive)
 939   (let ((str
 940          (save-excursion
 941            (set-buffer bookmark-current-buffer)
 942            bookmark-current-bookmark)))
 943     (if str (insert str) (bookmark-insert-buffer-name))))
 944
 945
 946 (defun bookmark-insert-buffer-name ()
 947   "Insert the current file name into the bookmark name being set.
 948 The directory part of the file name is not used."
 949   (interactive)
 950   (let ((str
 951          (save-excursion
 952            (set-buffer bookmark-current-buffer)
 953            (bookmark-buffer-name))))
 954     (insert str)))
 955
 956
 957 (defun bookmark-buffer-name ()
 958   "Return the name of the current buffer's file, non-directory.
 959 In Info, return the current node."
 960   (cond
 961    ;; Are we in Info?
 962    ((string-equal mode-name "Info") Info-current-node)
 963    ;; Or are we a file?
 964    (buffer-file-name (file-name-nondirectory buffer-file-name))
 965    ;; Or are we a directory?
 966    ((and (boundp 'dired-directory) dired-directory)
 967     (let* ((dirname (if (stringp dired-directory)
 968                         dired-directory
 969                       (car dired-directory)))
 970            (idx (1- (length dirname))))
 971       ;; Strip the trailing slash.
 972       (if (= ?/ (aref dirname idx))
 973           (file-name-nondirectory (substring dirname 0 idx))
 974         ;; Else return the current-buffer
 975         (buffer-name (current-buffer)))))
 976    ;; If all else fails, use the buffer's name.
 977    (t
 978     (buffer-name (current-buffer)))))
 979
 980
 981 (defun bookmark-yank-word ()
 982   (interactive)
 983   ;; get the next word from the buffer and append it to the name of
 984   ;; the bookmark currently being set.
 985   (let ((string (save-excursion
 986                     (set-buffer bookmark-current-buffer)
 987                     (goto-char bookmark-yank-point)
 988                     (buffer-substring-no-properties
 989                      (point)
 990                      (progn
 991                        (forward-word 1)
 992                        (setq bookmark-yank-point (point)))))))
 993     (insert string)))
 994
 995
 996 (defvar Info-current-file)
 997
 998 (defun bookmark-buffer-file-name ()
 999   "Return the current buffer's file in a way useful for bookmarks.
1000 For example, if this is a Info buffer, return the Info file's name."
1001   (if (eq major-mode 'Info-mode)
1002         Info-current-file
1003     (or
1004      buffer-file-name
1005      (if (and (boundp 'dired-directory) dired-directory)
1006          (if (stringp dired-directory)
1007              dired-directory
1008            (car dired-directory))))))
1009
1010
1011 (defun bookmark-maybe-load-default-file ()
1012   (and (not bookmarks-already-loaded)
1013        (null bookmark-alist)
1014        (prog2
1015            (and
1016             ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
1017             ;; to be renamed.
1018             (file-exists-p (expand-file-name bookmark-old-default-file))
1019             (not (file-exists-p (expand-file-name bookmark-default-file)))
1020             (rename-file (expand-file-name bookmark-old-default-file)
1021                          (expand-file-name bookmark-default-file)))
1022            ;; return t so the `and' will continue...
1023            t)
1024
1025        (file-readable-p (expand-file-name bookmark-default-file))
1026        (bookmark-load bookmark-default-file t t)
1027        (setq bookmarks-already-loaded t)))
1028
1029
1030 (defun bookmark-maybe-sort-alist ()
1031   ;;Return the bookmark-alist for display.  If the bookmark-sort-flag
1032   ;;is non-nil, then return a sorted copy of the alist.
1033   (if bookmark-sort-flag
1034       (setq bookmark-alist
1035             (sort (copy-alist bookmark-alist)
1036                   (function
1037                    (lambda (x y) (string-lessp (car x) (car y))))))))
1038
1039
1040 (defvar bookmark-after-jump-hook nil
1041   "Hook run after `bookmark-jump' jumps to a bookmark.
1042 Useful for example to unhide text in `outline-mode'.")
1043
1044 ;;;###autoload
1045 (defun bookmark-jump (bookmark)
1046   "Jump to bookmark BOOKMARK (a point in some file).
1047 You may have a problem using this function if the value of variable
1048 `bookmark-alist' is nil.  If that happens, you need to load in some
1049 bookmarks.  See help on function `bookmark-load' for more about
1050 this.
1051
1052 If the file pointed to by BOOKMARK no longer exists, you will be asked
1053 if you wish to give the bookmark a new location, and `bookmark-jump'
1054 will then jump to the new location, as well as recording it in place
1055 of the old one in the permanent bookmark record."
1056   (interactive
1057    (list (bookmark-completing-read "Jump to bookmark"
1058                                    bookmark-current-bookmark)))
1059   (unless bookmark
1060     (error "No bookmark specified"))
1061   (bookmark-maybe-historicize-string bookmark)
1062   (let ((cell (bookmark-jump-noselect bookmark)))
1063     (and cell
1064          (switch-to-buffer (car cell))
1065          (goto-char (cdr cell))
1066          (progn (run-hooks 'bookmark-after-jump-hook) t)
1067          (if bookmark-automatically-show-annotations
1068              ;; if there is an annotation for this bookmark,
1069              ;; show it in a buffer.
1070              (bookmark-show-annotation bookmark)))))
1071
1072
1073 (defun bookmark-file-or-variation-thereof (file)
1074   "Return FILE (a string) if it exists, or return a reasonable
1075 variation of FILE if that exists.  Reasonable variations are checked
1076 by appending suffixes defined in `Info-suffix-list'.  If cannot find FILE
1077 nor a reasonable variation thereof, then still return FILE if it can
1078 be retrieved from a VC backend, else return nil."
1079   (if (file-exists-p file)
1080       file
1081     (or
1082      (progn (require 'info)  ; ensure Info-suffix-list is bound
1083             (catch 'found
1084               (mapc (lambda (elt)
1085                       (let ((suffixed-file (concat file (car elt))))
1086                         (if (file-exists-p suffixed-file)
1087                             (throw 'found suffixed-file))))
1088                     Info-suffix-list)
1089               nil))
1090      ;; Last possibility: try VC
1091      (if (vc-backend file) file))))
1092
1093
1094 (defun bookmark-jump-noselect (str)
1095   ;; a leetle helper for bookmark-jump :-)
1096   ;; returns (BUFFER . POINT)
1097   (bookmark-maybe-load-default-file)
1098   (let* ((file (expand-file-name (bookmark-get-filename str)))
1099          (forward-str            (bookmark-get-front-context-string str))
1100          (behind-str             (bookmark-get-rear-context-string str))
1101          (place                  (bookmark-get-position str))
1102          (info-node              (bookmark-get-info-node str))
1103          (orig-file              file)
1104          )
1105     (if (setq file (bookmark-file-or-variation-thereof file))
1106         (save-excursion
1107           (save-window-excursion
1108             (if info-node
1109                 ;; Info nodes must be visited with care.
1110                 (progn
1111                   (require 'info)
1112                   (with-no-warnings
1113                     (Info-find-node file info-node)))
1114               ;; Else no Info.  Can do an ordinary find-file:
1115               (set-buffer (find-file-noselect file))
1116               (goto-char place))
1117
1118             ;; Go searching forward first.  Then, if forward-str exists and
1119             ;; was found in the file, we can search backward for behind-str.
1120             ;; Rationale is that if text was inserted between the two in the
1121             ;; file, it's better to be put before it so you can read it,
1122             ;; rather than after and remain perhaps unaware of the changes.
1123             (if forward-str
1124                 (if (search-forward forward-str (point-max) t)
1125                     (goto-char (match-beginning 0))))
1126             (if behind-str
1127                 (if (search-backward behind-str (point-min) t)
1128                     (goto-char (match-end 0))))
1129             ;; added by db
1130             (setq bookmark-current-bookmark str)
1131             (cons (current-buffer) (point))))
1132
1133       ;; Else unable to find the marked file, so ask if user wants to
1134       ;; relocate the bookmark, else remind them to consider deletion.
1135       (ding)
1136       (if (y-or-n-p (concat (file-name-nondirectory orig-file)
1137                             " nonexistent.  Relocate \""
1138                             str
1139                             "\"? "))
1140           (progn
1141             (bookmark-relocate str)
1142             ;; gasp!  It's a recursive function call in Emacs Lisp!
1143             (bookmark-jump-noselect str))
1144         (message
1145          "Bookmark not relocated; consider removing it \(%s\)." str)
1146         nil))))
1147
1148
1149 ;;;###autoload
1150 (defun bookmark-relocate (bookmark)
1151   "Relocate BOOKMARK to another file (reading file name with minibuffer).
1152 This makes an already existing bookmark point to that file, instead of
1153 the one it used to point at.  Useful when a file has been renamed
1154 after a bookmark was set in it."
1155   (interactive (list (bookmark-completing-read "Bookmark to relocate")))
1156   (bookmark-maybe-historicize-string bookmark)
1157   (bookmark-maybe-load-default-file)
1158   (let* ((bmrk-filename (bookmark-get-filename bookmark))
1159          (newloc (expand-file-name
1160                   (read-file-name
1161                    (format "Relocate %s to: " bookmark)
1162                    (file-name-directory bmrk-filename)))))
1163     (bookmark-set-filename bookmark newloc)
1164     (bookmark-bmenu-surreptitiously-rebuild-list)))
1165
1166
1167 ;;;###autoload
1168 (defun bookmark-insert-location (bookmark &optional no-history)
1169   "Insert the name of the file associated with BOOKMARK.
1170 Optional second arg NO-HISTORY means don't record this in the
1171 minibuffer history list `bookmark-history'."
1172   (interactive (list (bookmark-completing-read "Insert bookmark location")))
1173   (or no-history (bookmark-maybe-historicize-string bookmark))
1174   (let ((start (point)))
1175     (prog1
1176         (insert (bookmark-location bookmark)) ; *Return this line*
1177       (if (and (display-color-p) (display-mouse-p))
1178           (add-text-properties start
1179                                (save-excursion (re-search-backward
1180                                                 "[^ \t]")
1181                                                (1+ (point)))
1182                                '(mouse-face highlight
1183                                  follow-link t
1184                                  help-echo "mouse-2: go to this bookmark"))))))
1185
1186 ;;;###autoload
1187 (defalias 'bookmark-locate 'bookmark-insert-location)
1188
1189 (defun bookmark-location (bookmark)
1190   "Return the name of the file associated with BOOKMARK."
1191   (bookmark-maybe-load-default-file)
1192   (bookmark-get-filename bookmark))
1193
1194
1195 ;;;###autoload
1196 (defun bookmark-rename (old &optional new)
1197   "Change the name of OLD bookmark to NEW name.
1198 If called from keyboard, prompt for OLD and NEW.  If called from
1199 menubar, select OLD from a menu and prompt for NEW.
1200
1201 If called from Lisp, prompt for NEW if only OLD was passed as an
1202 argument.  If called with two strings, then no prompting is done.  You
1203 must pass at least OLD when calling from Lisp.
1204
1205 While you are entering the new name, consecutive C-w's insert
1206 consecutive words from the text of the buffer into the new bookmark
1207 name."
1208   (interactive (list (bookmark-completing-read "Old bookmark name")))
1209   (bookmark-maybe-historicize-string old)
1210   (bookmark-maybe-load-default-file)
1211
1212   (setq bookmark-current-point (point))
1213   (setq bookmark-yank-point (point))
1214   (setq bookmark-current-buffer (current-buffer))
1215   (let ((newname
1216          (or new   ; use second arg, if non-nil
1217              (read-from-minibuffer
1218               "New name: "
1219               nil
1220               (let ((now-map (copy-keymap minibuffer-local-map)))
1221                 (define-key now-map  "\C-w" 'bookmark-yank-word)
1222                 now-map)
1223               nil
1224               'bookmark-history))))
1225     (bookmark-set-name old newname)
1226     (setq bookmark-current-bookmark newname)
1227     (bookmark-bmenu-surreptitiously-rebuild-list)
1228     (setq bookmark-alist-modification-count
1229           (1+ bookmark-alist-modification-count))
1230     (if (bookmark-time-to-save-p)
1231         (bookmark-save))))
1232
1233
1234 ;;;###autoload
1235 (defun bookmark-insert (bookmark)
1236   "Insert the text of the file pointed to by bookmark BOOKMARK.
1237 You may have a problem using this function if the value of variable
1238 `bookmark-alist' is nil.  If that happens, you need to load in some
1239 bookmarks.  See help on function `bookmark-load' for more about
1240 this."
1241   (interactive (list (bookmark-completing-read "Insert bookmark contents")))
1242   (bookmark-maybe-historicize-string bookmark)
1243   (bookmark-maybe-load-default-file)
1244   (let ((orig-point (point))
1245         (str-to-insert
1246          (save-excursion
1247            (set-buffer (car (bookmark-jump-noselect bookmark)))
1248            (buffer-string))))
1249     (insert str-to-insert)
1250     (push-mark)
1251     (goto-char orig-point)))
1252
1253
1254 ;;;###autoload
1255 (defun bookmark-delete (bookmark &optional batch)
1256   "Delete BOOKMARK from the bookmark list.
1257 Removes only the first instance of a bookmark with that name.  If
1258 there are one or more other bookmarks with the same name, they will
1259 not be deleted.  Defaults to the \"current\" bookmark \(that is, the
1260 one most recently used in this file, if any\).
1261 Optional second arg BATCH means don't update the bookmark list buffer,
1262 probably because we were called from there."
1263   (interactive
1264    (list (bookmark-completing-read "Delete bookmark"
1265                                    bookmark-current-bookmark)))
1266   (bookmark-maybe-historicize-string bookmark)
1267   (bookmark-maybe-load-default-file)
1268   (let ((will-go (bookmark-get-bookmark bookmark)))
1269     (setq bookmark-alist (delq will-go bookmark-alist))
1270     ;; Added by db, nil bookmark-current-bookmark if the last
1271     ;; occurrence has been deleted
1272     (or (bookmark-get-bookmark bookmark-current-bookmark)
1273         (setq bookmark-current-bookmark nil)))
1274   ;; Don't rebuild the list
1275   (if batch
1276       nil
1277     (bookmark-bmenu-surreptitiously-rebuild-list)
1278     (setq bookmark-alist-modification-count
1279           (1+ bookmark-alist-modification-count))
1280     (if (bookmark-time-to-save-p)
1281         (bookmark-save))))
1282
1283
1284 (defun bookmark-time-to-save-p (&optional last-time)
1285   ;; By Gregory M. Saunders <saunders@cis.ohio-state.edu>
1286   ;; finds out whether it's time to save bookmarks to a file, by
1287   ;; examining the value of variable bookmark-save-flag, and maybe
1288   ;; bookmark-alist-modification-count.  Returns t if they should be
1289   ;; saved, nil otherwise.  if last-time is non-nil, then this is
1290   ;; being called when emacs is killed.
1291   (cond (last-time
1292          (and (> bookmark-alist-modification-count 0)
1293               bookmark-save-flag))
1294         ((numberp bookmark-save-flag)
1295          (>= bookmark-alist-modification-count bookmark-save-flag))
1296         (t
1297          nil)))
1298
1299
1300 ;;;###autoload
1301 (defun bookmark-write ()
1302   "Write bookmarks to a file (reading the file name with the minibuffer).
1303 Don't use this in Lisp programs; use `bookmark-save' instead."
1304   (interactive)
1305   (bookmark-maybe-load-default-file)
1306   (bookmark-save t))
1307
1308
1309 ;;;###autoload
1310 (defun bookmark-save (&optional parg file)
1311   "Save currently defined bookmarks.
1312 Saves by default in the file defined by the variable
1313 `bookmark-default-file'.  With a prefix arg, save it in file FILE
1314 \(second argument\).
1315
1316 If you are calling this from Lisp, the two arguments are PARG and
1317 FILE, and if you just want it to write to the default file, then
1318 pass no arguments.  Or pass in nil and FILE, and it will save in FILE
1319 instead.  If you pass in one argument, and it is non-nil, then the
1320 user will be interactively queried for a file to save in.
1321
1322 When you want to load in the bookmarks from a file, use
1323 \`bookmark-load\', \\[bookmark-load].  That function will prompt you
1324 for a file, defaulting to the file defined by variable
1325 `bookmark-default-file'."
1326   (interactive "P")
1327   (bookmark-maybe-load-default-file)
1328   (cond
1329    ((and (null parg) (null file))
1330     ;;whether interactive or not, write to default file
1331     (bookmark-write-file bookmark-default-file))
1332    ((and (null parg) file)
1333     ;;whether interactive or not, write to given file
1334     (bookmark-write-file file))
1335    ((and parg (not file))
1336     ;;have been called interactively w/ prefix arg
1337     (let ((file (read-file-name "File to save bookmarks in: ")))
1338       (bookmark-write-file file)))
1339    (t ; someone called us with prefix-arg *and* a file, so just write to file
1340     (bookmark-write-file file)))
1341   ;; signal that we have synced the bookmark file by setting this to
1342   ;; 0.  If there was an error at any point before, it will not get
1343   ;; set, which is what we want.
1344   (setq bookmark-alist-modification-count 0))
1345
1346
1347 \f
1348 (defun bookmark-write-file (file)
1349   (save-excursion
1350     (save-window-excursion
1351       (if (>= baud-rate 9600)
1352           (message "Saving bookmarks to file %s..." file))
1353       (set-buffer (let ((enable-local-variables nil))
1354                     (find-file-noselect file)))
1355       (goto-char (point-min))
1356       (let ((print-length nil)
1357             (print-level nil))
1358         (delete-region (point-min) (point-max))
1359         (bookmark-insert-file-format-version-stamp)
1360         (pp bookmark-alist (current-buffer))
1361         (let ((version-control
1362                (cond
1363                 ((null bookmark-version-control) nil)
1364                 ((eq 'never bookmark-version-control) 'never)
1365                 ((eq 'nospecial bookmark-version-control) version-control)
1366                 (t
1367                  t))))
1368           (condition-case nil
1369               (write-file file)
1370             (file-error (message "Can't write %s" file)))
1371           (kill-buffer (current-buffer))
1372           (if (>= baud-rate 9600)
1373               (message "Saving bookmarks to file %s...done" file)))))))
1374
1375
1376 (defun bookmark-import-new-list (new-list)
1377   ;; Walk over the new list, adding each individual bookmark
1378   ;; carefully.  "Carefully" means checking against the existing
1379   ;; bookmark-alist and renaming the new bookmarks with <N> extensions
1380   ;; as necessary.
1381   (let ((lst new-list)
1382         (names (bookmark-all-names)))
1383     (while lst
1384       (let* ((full-record (car lst)))
1385         (bookmark-maybe-rename full-record names)
1386         (setq bookmark-alist (nconc bookmark-alist (list full-record)))
1387         (setq names (cons (bookmark-name-from-full-record full-record) names))
1388         (setq lst (cdr lst))))))
1389
1390
1391 (defun bookmark-maybe-rename (full-record names)
1392   ;; just a helper for bookmark-import-new-list; it is only for
1393   ;; readability that this is not inlined.
1394   ;;
1395   ;; Once this has found a free name, it sets full-record to that
1396   ;; name.
1397   (let ((found-name (bookmark-name-from-full-record full-record)))
1398     (if (member found-name names)
1399         ;; We've got a conflict, so generate a new name
1400         (let ((count 2)
1401               (new-name found-name))
1402           (while (member new-name names)
1403             (setq new-name (concat found-name (format "<%d>" count)))
1404             (setq count (1+ count)))
1405           (bookmark-set-name full-record new-name)))))
1406
1407
1408 ;;;###autoload
1409 (defun bookmark-load (file &optional overwrite no-msg)
1410   "Load bookmarks from FILE (which must be in bookmark format).
1411 Appends loaded bookmarks to the front of the list of bookmarks.  If
1412 optional second argument OVERWRITE is non-nil, existing bookmarks are
1413 destroyed.  Optional third arg NO-MSG means don't display any messages
1414 while loading.
1415
1416 If you load a file that doesn't contain a proper bookmark alist, you
1417 will corrupt Emacs's bookmark list.  Generally, you should only load
1418 in files that were created with the bookmark functions in the first
1419 place.  Your own personal bookmark file, `~/.emacs.bmk', is
1420 maintained automatically by Emacs; you shouldn't need to load it
1421 explicitly.
1422
1423 If you load a file containing bookmarks with the same names as
1424 bookmarks already present in your Emacs, the new bookmarks will get
1425 unique numeric suffixes \"<2>\", \"<3>\", ... following the same
1426 method buffers use to resolve name collisions."
1427   (interactive
1428    (list (read-file-name
1429           (format "Load bookmarks from: (%s) "
1430                   bookmark-default-file)
1431           ;;Default might not be used often,
1432           ;;but there's no better default, and
1433           ;;I guess it's better than none at all.
1434           "~/" bookmark-default-file 'confirm)))
1435   (setq file (expand-file-name file))
1436   (if (file-readable-p file)
1437       (save-excursion
1438         (save-window-excursion
1439           (if (and (null no-msg) (>= baud-rate 9600))
1440               (message "Loading bookmarks from %s..." file))
1441           (set-buffer (let ((enable-local-variables nil))
1442                         (find-file-noselect file)))
1443           (goto-char (point-min))
1444           (bookmark-maybe-upgrade-file-format)
1445           (let ((blist (bookmark-alist-from-buffer)))
1446             (if (listp blist)
1447                 (progn
1448                   (if overwrite
1449                       (progn
1450                         (setq bookmark-alist blist)
1451                         (setq bookmark-alist-modification-count 0))
1452                     ;; else
1453                     (bookmark-import-new-list blist)
1454                     (setq bookmark-alist-modification-count
1455                           (1+ bookmark-alist-modification-count)))
1456                   (if (string-equal
1457                        (expand-file-name bookmark-default-file)
1458                        file)
1459                       (setq bookmarks-already-loaded t))
1460                   (bookmark-bmenu-surreptitiously-rebuild-list))
1461               (error "Invalid bookmark list in %s" file)))
1462           (kill-buffer (current-buffer)))
1463         (if (and (null no-msg) (>= baud-rate 9600))
1464             (message "Loading bookmarks from %s...done" file)))
1465     (error "Cannot read bookmark file %s" file)))
1466
1467
1468 \f
1469 ;;; Code supporting the dired-like bookmark menu.  Prefix is
1470 ;;; "bookmark-bmenu" for "buffer-menu":
1471
1472
1473 (defvar bookmark-bmenu-bookmark-column nil)
1474
1475
1476 (defvar bookmark-bmenu-hidden-bookmarks ())
1477
1478
1479 (defvar bookmark-bmenu-mode-map nil)
1480
1481
1482 (if bookmark-bmenu-mode-map
1483     nil
1484   (setq bookmark-bmenu-mode-map (make-keymap))
1485   (suppress-keymap bookmark-bmenu-mode-map t)
1486   (define-key bookmark-bmenu-mode-map "q" 'quit-window)
1487   (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
1488   (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
1489   (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
1490   (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window)
1491   (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
1492   (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
1493   (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
1494   (define-key bookmark-bmenu-mode-map "\C-m" 'bookmark-bmenu-this-window)
1495   (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
1496   (define-key bookmark-bmenu-mode-map "\C-o"
1497     'bookmark-bmenu-switch-other-window)
1498   (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save)
1499   (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete)
1500   (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards)
1501   (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions)
1502   (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete)
1503   (define-key bookmark-bmenu-mode-map " " 'next-line)
1504   (define-key bookmark-bmenu-mode-map "n" 'next-line)
1505   (define-key bookmark-bmenu-mode-map "p" 'previous-line)
1506   (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark)
1507   (define-key bookmark-bmenu-mode-map "?" 'describe-mode)
1508   (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark)
1509   (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark)
1510   (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
1511   (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
1512   (define-key bookmark-bmenu-mode-map "R" 'bookmark-bmenu-relocate)
1513   (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
1514   (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
1515   (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
1516   (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)
1517   (define-key bookmark-bmenu-mode-map [mouse-2]
1518     'bookmark-bmenu-other-window-with-mouse))
1519
1520
1521
1522 ;; Bookmark Buffer Menu mode is suitable only for specially formatted
1523 ;; data.
1524 (put 'bookmark-bmenu-mode 'mode-class 'special)
1525
1526
1527 ;; todo: need to display whether or not bookmark exists as a buffer in
1528 ;; flag column.
1529
1530 ;; Format:
1531 ;; FLAGS  BOOKMARK [ LOCATION ]
1532
1533
1534 (defun bookmark-bmenu-surreptitiously-rebuild-list ()
1535   "Rebuild the Bookmark List if it exists.
1536 Don't affect the buffer ring order."
1537   (if (get-buffer "*Bookmark List*")
1538       (save-excursion
1539         (save-window-excursion
1540           (bookmark-bmenu-list)))))
1541
1542
1543 ;;;###autoload
1544 (defun bookmark-bmenu-list ()
1545   "Display a list of existing bookmarks.
1546 The list is displayed in a buffer named `*Bookmark List*'.
1547 The leftmost column displays a D if the bookmark is flagged for
1548 deletion, or > if it is flagged for displaying."
1549   (interactive)
1550   (bookmark-maybe-load-default-file)
1551   (if (interactive-p)
1552       (switch-to-buffer (get-buffer-create "*Bookmark List*"))
1553     (set-buffer (get-buffer-create "*Bookmark List*")))
1554   (let ((inhibit-read-only t))
1555     (erase-buffer)
1556     (insert "% Bookmark\n- --------\n")
1557     (bookmark-maybe-sort-alist)
1558     (mapcar
1559      (lambda (full-record)
1560        ;; if a bookmark has an annotation, prepend a "*"
1561        ;; in the list of bookmarks.
1562        (let ((annotation (bookmark-get-annotation
1563                           (bookmark-name-from-full-record full-record))))
1564          (if (and annotation (not (string-equal annotation "")))
1565              (insert " *")
1566            (insert "  "))
1567          (let ((start (point)))
1568            (insert (bookmark-name-from-full-record full-record))
1569            (if (and (display-color-p) (display-mouse-p))
1570                (add-text-properties start
1571                                     (save-excursion (re-search-backward
1572                                                      "[^ \t]")
1573                                                     (1+ (point)))
1574                                     '(mouse-face highlight
1575                                       follow-link t
1576                                       help-echo "mouse-2: go to this bookmark")))
1577            (insert "\n")
1578            )))
1579      bookmark-alist))
1580   (goto-char (point-min))
1581   (forward-line 2)
1582   (bookmark-bmenu-mode)
1583   (if bookmark-bmenu-toggle-filenames
1584       (bookmark-bmenu-toggle-filenames t)))
1585
1586 ;;;###autoload
1587 (defalias 'list-bookmarks 'bookmark-bmenu-list)
1588 ;;;###autoload
1589 (defalias 'edit-bookmarks 'bookmark-bmenu-list)
1590
1591
1592
1593 (defun bookmark-bmenu-mode ()
1594   "Major mode for editing a list of bookmarks.
1595 Each line describes one of the bookmarks in Emacs.
1596 Letters do not insert themselves; instead, they are commands.
1597 Bookmark names preceded by a \"*\" have annotations.
1598 \\<bookmark-bmenu-mode-map>
1599 \\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
1600 \\[bookmark-bmenu-select] -- select bookmark of line point is on.
1601   Also show bookmarks marked using m in other windows.
1602 \\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
1603 \\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
1604 \\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window.
1605 \\[bookmark-bmenu-2-window] -- select this bookmark in one window,
1606   together with bookmark selected before this one in another window.
1607 \\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer.
1608 \\[bookmark-bmenu-other-window] -- select this bookmark in another window,
1609   so the bookmark menu bookmark remains visible in its window.
1610 \\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
1611 \\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
1612 \\[bookmark-bmenu-relocate] -- relocate this bookmark's file \(prompts for new file\).
1613 \\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
1614 \\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
1615 \\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
1616 \\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
1617   With a prefix arg, prompts for a file to save in.
1618 \\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
1619 \\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
1620   With prefix argument, also move up one line.
1621 \\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
1622 \\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
1623   in another buffer.
1624 \\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
1625 \\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
1626   (kill-all-local-variables)
1627   (use-local-map bookmark-bmenu-mode-map)
1628   (setq truncate-lines t)
1629   (setq buffer-read-only t)
1630   (setq major-mode 'bookmark-bmenu-mode)
1631   (setq mode-name "Bookmark Menu")
1632   (run-mode-hooks 'bookmark-bmenu-mode-hook))
1633
1634
1635 (defun bookmark-bmenu-toggle-filenames (&optional show)
1636   "Toggle whether filenames are shown in the bookmark list.
1637 Optional argument SHOW means show them unconditionally."
1638   (interactive)
1639   (cond
1640    (show
1641     (setq bookmark-bmenu-toggle-filenames nil)
1642     (bookmark-bmenu-show-filenames)
1643     (setq bookmark-bmenu-toggle-filenames t))
1644    (bookmark-bmenu-toggle-filenames
1645     (bookmark-bmenu-hide-filenames)
1646     (setq bookmark-bmenu-toggle-filenames nil))
1647    (t
1648     (bookmark-bmenu-show-filenames)
1649     (setq bookmark-bmenu-toggle-filenames t))))
1650
1651
1652 (defun bookmark-bmenu-show-filenames (&optional force)
1653   (if (and (not force) bookmark-bmenu-toggle-filenames)
1654       nil ;already shown, so do nothing
1655     (save-excursion
1656       (save-window-excursion
1657         (goto-char (point-min))
1658         (forward-line 2)
1659         (setq bookmark-bmenu-hidden-bookmarks ())
1660         (let ((inhibit-read-only t))
1661           (while (< (point) (point-max))
1662             (let ((bmrk (bookmark-bmenu-bookmark)))
1663               (setq bookmark-bmenu-hidden-bookmarks
1664                     (cons bmrk bookmark-bmenu-hidden-bookmarks))
1665               (let ((start (save-excursion (end-of-line) (point))))
1666                 (move-to-column bookmark-bmenu-file-column t)
1667                 ;; Strip off `mouse-face' from the white spaces region.
1668                 (if (and (display-color-p) (display-mouse-p))
1669                     (remove-text-properties start (point)
1670                                             '(mouse-face nil help-echo nil))))
1671               (delete-region (point) (progn (end-of-line) (point)))
1672               (insert "  ")
1673               ;; Pass the NO-HISTORY arg:
1674               (bookmark-insert-location bmrk t)
1675               (forward-line 1))))))))
1676
1677
1678 (defun bookmark-bmenu-hide-filenames (&optional force)
1679   (if (and (not force) bookmark-bmenu-toggle-filenames)
1680       ;; nothing to hide if above is nil
1681       (save-excursion
1682         (save-window-excursion
1683           (goto-char (point-min))
1684           (forward-line 2)
1685           (setq bookmark-bmenu-hidden-bookmarks
1686                 (nreverse bookmark-bmenu-hidden-bookmarks))
1687           (save-excursion
1688             (goto-char (point-min))
1689             (search-forward "Bookmark")
1690             (backward-word 1)
1691             (setq bookmark-bmenu-bookmark-column (current-column)))
1692           (save-excursion
1693             (let ((inhibit-read-only t))
1694               (while bookmark-bmenu-hidden-bookmarks
1695                 (move-to-column bookmark-bmenu-bookmark-column t)
1696                 (bookmark-kill-line)
1697                 (let ((start (point)))
1698                   (insert (car bookmark-bmenu-hidden-bookmarks))
1699                   (if (and (display-color-p) (display-mouse-p))
1700                       (add-text-properties start
1701                                            (save-excursion (re-search-backward
1702                                                             "[^ \t]")
1703                                                            (1+ (point)))
1704                                            '(mouse-face highlight
1705                                              follow-link t
1706                                              help-echo
1707                                              "mouse-2: go to this bookmark"))))
1708                 (setq bookmark-bmenu-hidden-bookmarks
1709                       (cdr bookmark-bmenu-hidden-bookmarks))
1710                 (forward-line 1))))))))
1711
1712
1713 (defun bookmark-bmenu-check-position ()
1714   ;; Returns non-nil if on a line with a bookmark.
1715   ;; (The actual value returned is bookmark-alist).
1716   ;; Else reposition and try again, else return nil.
1717   (cond ((< (count-lines (point-min) (point)) 2)
1718          (goto-char (point-min))
1719          (forward-line 2)
1720          bookmark-alist)
1721         ((and (bolp) (eobp))
1722          (beginning-of-line 0)
1723          bookmark-alist)
1724         (t
1725          bookmark-alist)))
1726
1727
1728 (defun bookmark-bmenu-bookmark ()
1729   ;; return a string which is bookmark of this line.
1730   (if (bookmark-bmenu-check-position)
1731       (save-excursion
1732         (save-window-excursion
1733           (goto-char (point-min))
1734           (search-forward "Bookmark")
1735           (backward-word 1)
1736           (setq bookmark-bmenu-bookmark-column (current-column)))))
1737   (if bookmark-bmenu-toggle-filenames
1738       (bookmark-bmenu-hide-filenames))
1739   (save-excursion
1740     (save-window-excursion
1741       (beginning-of-line)
1742       (forward-char bookmark-bmenu-bookmark-column)
1743       (prog1
1744           (buffer-substring-no-properties (point)
1745                             (progn
1746                               (end-of-line)
1747                               (point)))
1748         ;; well, this is certainly crystal-clear:
1749         (if bookmark-bmenu-toggle-filenames
1750             (bookmark-bmenu-toggle-filenames t))))))
1751
1752
1753 (defun bookmark-show-annotation (bookmark)
1754   "Display the annotation for bookmark named BOOKMARK in a buffer,
1755 if an annotation exists."
1756   (let ((annotation (bookmark-get-annotation bookmark)))
1757     (if (and annotation (not (string-equal annotation "")))
1758         (save-excursion
1759           (let ((old-buf (current-buffer)))
1760             (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1761             (delete-region (point-min) (point-max))
1762             ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
1763             (insert annotation)
1764             (goto-char (point-min))
1765             (pop-to-buffer old-buf))))))
1766
1767
1768 (defun bookmark-show-all-annotations ()
1769   "Display the annotations for all bookmarks in a buffer."
1770   (let ((old-buf (current-buffer)))
1771     (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
1772     (delete-region (point-min) (point-max))
1773     (mapcar
1774      (lambda (full-record)
1775        (let* ((name (bookmark-name-from-full-record full-record))
1776               (ann  (bookmark-get-annotation name)))
1777          (insert (concat name ":\n"))
1778          (if (and ann (not (string-equal ann "")))
1779              ;; insert the annotation, indented by 4 spaces.
1780              (progn
1781                (save-excursion (insert ann))
1782                (while (< (point) (point-max))
1783                  (beginning-of-line) ; paranoia
1784                  (insert "    ")
1785                  (forward-line)
1786                  (end-of-line))))))
1787      bookmark-alist)
1788     (goto-char (point-min))
1789     (pop-to-buffer old-buf)))
1790
1791
1792 (defun bookmark-bmenu-mark ()
1793   "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
1794   (interactive)
1795   (beginning-of-line)
1796   (if (bookmark-bmenu-check-position)
1797       (let ((inhibit-read-only t))
1798         (delete-char 1)
1799         (insert ?>)
1800         (forward-line 1)
1801         (bookmark-bmenu-check-position))))
1802
1803
1804 (defun bookmark-bmenu-select ()
1805   "Select this line's bookmark; also display bookmarks marked with `>'.
1806 You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
1807   (interactive)
1808   (if (bookmark-bmenu-check-position)
1809       (let ((bmrk (bookmark-bmenu-bookmark))
1810             (menu (current-buffer))
1811             (others ())
1812             tem)
1813         (goto-char (point-min))
1814         (while (re-search-forward "^>" nil t)
1815           (setq tem (bookmark-bmenu-bookmark))
1816           (let ((inhibit-read-only t))
1817             (delete-char -1)
1818             (insert ?\s))
1819           (or (string-equal tem bmrk)
1820               (member tem others)
1821               (setq others (cons tem others))))
1822         (setq others (nreverse others)
1823               tem (/ (1- (frame-height)) (1+ (length others))))
1824         (delete-other-windows)
1825         (bookmark-jump bmrk)
1826         (bury-buffer menu)
1827         (if others
1828             (while others
1829               (split-window nil tem)
1830               (other-window 1)
1831               (bookmark-jump (car others))
1832               (setq others (cdr others)))
1833           (other-window 1)))))
1834
1835
1836 (defun bookmark-bmenu-save (parg)
1837   "Save the current list into a bookmark file.
1838 With a prefix arg, prompts for a file to save them in."
1839   (interactive "P")
1840   (save-excursion
1841     (save-window-excursion
1842       (bookmark-save parg))))
1843
1844
1845 (defun bookmark-bmenu-load ()
1846   "Load the bookmark file and rebuild the bookmark menu-buffer."
1847   (interactive)
1848   (if (bookmark-bmenu-check-position)
1849       (save-excursion
1850         (save-window-excursion
1851           ;; This will call `bookmark-bmenu-list'
1852           (call-interactively 'bookmark-load)))))
1853
1854
1855 (defun bookmark-bmenu-1-window ()
1856   "Select this line's bookmark, alone, in full frame."
1857   (interactive)
1858   (if (bookmark-bmenu-check-position)
1859       (progn
1860         (bookmark-jump (bookmark-bmenu-bookmark))
1861         (bury-buffer (other-buffer))
1862         (delete-other-windows))))
1863
1864
1865 (defun bookmark-bmenu-2-window ()
1866   "Select this line's bookmark, with previous buffer in second window."
1867   (interactive)
1868   (if (bookmark-bmenu-check-position)
1869       (let ((bmrk (bookmark-bmenu-bookmark))
1870             (menu (current-buffer))
1871             (pop-up-windows t))
1872         (delete-other-windows)
1873         (switch-to-buffer (other-buffer))
1874         (let* ((pair (bookmark-jump-noselect bmrk))
1875                (buff (car pair))
1876                (pos  (cdr pair)))
1877           (pop-to-buffer buff)
1878           (goto-char pos))
1879         (bury-buffer menu))))
1880
1881
1882 (defun bookmark-bmenu-this-window ()
1883   "Select this line's bookmark in this window."
1884   (interactive)
1885   (if (bookmark-bmenu-check-position)
1886       (bookmark-jump (bookmark-bmenu-bookmark))))
1887
1888
1889 (defun bookmark-bmenu-other-window ()
1890   "Select this line's bookmark in other window, leaving bookmark menu visible."
1891   (interactive)
1892   (let ((bookmark (bookmark-bmenu-bookmark)))
1893     (if (bookmark-bmenu-check-position)
1894         (let* ((pair (bookmark-jump-noselect bookmark))
1895                (buff (car pair))
1896                (pos  (cdr pair)))
1897           (switch-to-buffer-other-window buff)
1898           (goto-char pos)
1899           (set-window-point (get-buffer-window buff) pos)
1900           (bookmark-show-annotation bookmark)))))
1901
1902
1903 (defun bookmark-bmenu-switch-other-window ()
1904   "Make the other window select this line's bookmark.
1905 The current window remains selected."
1906   (interactive)
1907   (let ((bookmark (bookmark-bmenu-bookmark))
1908         (pop-up-windows t)
1909         same-window-buffer-names
1910         same-window-regexps)
1911     (if (bookmark-bmenu-check-position)
1912         (let* ((pair (bookmark-jump-noselect bookmark))
1913                (buff (car pair))
1914                (pos  (cdr pair)))
1915           (display-buffer buff)
1916           (let ((o-buffer (current-buffer)))
1917             ;; save-excursion won't do
1918             (set-buffer buff)
1919             (goto-char pos)
1920             (set-window-point (get-buffer-window buff) pos)
1921             (set-buffer o-buffer))
1922           (bookmark-show-annotation bookmark)))))
1923
1924 (defun bookmark-bmenu-other-window-with-mouse (event)
1925   "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
1926   (interactive "e")
1927   (save-excursion
1928     (set-buffer (window-buffer (posn-window (event-end event))))
1929     (save-excursion
1930       (goto-char (posn-point (event-end event)))
1931       (bookmark-bmenu-other-window))))
1932
1933
1934 (defun bookmark-bmenu-show-annotation ()
1935   "Show the annotation for the current bookmark in another window."
1936   (interactive)
1937   (let ((bookmark (bookmark-bmenu-bookmark)))
1938     (if (bookmark-bmenu-check-position)
1939         (bookmark-show-annotation bookmark))))
1940
1941
1942 (defun bookmark-bmenu-show-all-annotations ()
1943   "Show the annotation for all bookmarks in another window."
1944   (interactive)
1945   (bookmark-show-all-annotations))
1946
1947
1948 (defun bookmark-bmenu-edit-annotation ()
1949   "Edit the annotation for the current bookmark in another window."
1950   (interactive)
1951   (let ((bookmark (bookmark-bmenu-bookmark)))
1952     (if (bookmark-bmenu-check-position)
1953         (bookmark-edit-annotation bookmark))))
1954
1955
1956 (defun bookmark-bmenu-unmark (&optional backup)
1957   "Cancel all requested operations on bookmark on this line and move down.
1958 Optional BACKUP means move up."
1959   (interactive "P")
1960   (beginning-of-line)
1961   (if (bookmark-bmenu-check-position)
1962       (progn
1963         (let ((inhibit-read-only t))
1964           (delete-char 1)
1965           ;; any flags to reset according to circumstances?  How about a
1966           ;; flag indicating whether this bookmark is being visited?
1967           ;; well, we don't have this now, so maybe later.
1968           (insert " "))
1969         (forward-line (if backup -1 1))
1970         (bookmark-bmenu-check-position))))
1971
1972
1973 (defun bookmark-bmenu-backup-unmark ()
1974   "Move up and cancel all requested operations on bookmark on line above."
1975   (interactive)
1976   (forward-line -1)
1977   (if (bookmark-bmenu-check-position)
1978       (progn
1979         (bookmark-bmenu-unmark)
1980         (forward-line -1)
1981         (bookmark-bmenu-check-position))))
1982
1983
1984 (defun bookmark-bmenu-delete ()
1985   "Mark bookmark on this line to be deleted.
1986 To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
1987   (interactive)
1988   (beginning-of-line)
1989   (if (bookmark-bmenu-check-position)
1990       (let ((inhibit-read-only t))
1991         (delete-char 1)
1992         (insert ?D)
1993         (forward-line 1)
1994         (bookmark-bmenu-check-position))))
1995
1996
1997 (defun bookmark-bmenu-delete-backwards ()
1998   "Mark bookmark on this line to be deleted, then move up one line.
1999 To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-execute-deletions]."
2000   (interactive)
2001   (bookmark-bmenu-delete)
2002   (forward-line -2)
2003   (if (bookmark-bmenu-check-position)
2004       (forward-line 1))
2005   (bookmark-bmenu-check-position))
2006
2007
2008 (defun bookmark-bmenu-execute-deletions ()
2009   "Delete bookmarks marked with \\<Buffer-menu-mode-map>\\[Buffer-menu-delete] commands."
2010   (interactive)
2011   (message "Deleting bookmarks...")
2012   (let ((hide-em bookmark-bmenu-toggle-filenames)
2013         (o-point  (point))
2014         (o-str    (save-excursion
2015                     (beginning-of-line)
2016                     (if (looking-at "^D")
2017                         nil
2018                       (buffer-substring
2019                        (point)
2020                        (progn (end-of-line) (point))))))
2021         (o-col     (current-column)))
2022     (if hide-em (bookmark-bmenu-hide-filenames))
2023     (setq bookmark-bmenu-toggle-filenames nil)
2024     (goto-char (point-min))
2025     (forward-line 1)
2026     (while (re-search-forward "^D" (point-max) t)
2027       (bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
2028     (bookmark-bmenu-list)
2029     (setq bookmark-bmenu-toggle-filenames hide-em)
2030     (if bookmark-bmenu-toggle-filenames
2031         (bookmark-bmenu-toggle-filenames t))
2032     (if o-str
2033         (progn
2034           (goto-char (point-min))
2035           (search-forward o-str)
2036           (beginning-of-line)
2037           (forward-char o-col))
2038       (goto-char o-point))
2039     (beginning-of-line)
2040     (setq bookmark-alist-modification-count
2041           (1+ bookmark-alist-modification-count))
2042     (if (bookmark-time-to-save-p)
2043         (bookmark-save))
2044     (message "Deleting bookmarks...done")
2045     ))
2046
2047
2048 (defun bookmark-bmenu-rename ()
2049   "Rename bookmark on current line.  Prompts for a new name."
2050   (interactive)
2051   (if (bookmark-bmenu-check-position)
2052       (let ((bmrk (bookmark-bmenu-bookmark))
2053             (thispoint (point)))
2054         (bookmark-rename bmrk)
2055         (bookmark-bmenu-list)
2056         (goto-char thispoint))))
2057
2058
2059 (defun bookmark-bmenu-locate ()
2060   "Display location of this bookmark.  Displays in the minibuffer."
2061   (interactive)
2062   (if (bookmark-bmenu-check-position)
2063       (let ((bmrk (bookmark-bmenu-bookmark)))
2064         (message "%s" (bookmark-location bmrk)))))
2065
2066 (defun bookmark-bmenu-relocate ()
2067   "Change the file path of the bookmark on the current line,
2068   prompting with completion for the new path."
2069   (interactive)
2070   (if (bookmark-bmenu-check-position)
2071       (let ((bmrk (bookmark-bmenu-bookmark))
2072             (thispoint (point)))
2073         (bookmark-relocate bmrk)
2074         (goto-char thispoint))))
2075
2076 \f
2077 ;;; Menu bar stuff.  Prefix is "bookmark-menu".
2078
2079 (defun bookmark-menu-popup-paned-menu (event name entries)
2080   "Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
2081 That is, ENTRIES is a list of strings which appear as the choices
2082 in the menu.
2083 The number of panes depends on the number of entries.
2084 The visible entries are truncated to `bookmark-menu-length', but the
2085 strings returned are not."
2086   (let ((f-height (/ (frame-height) 2))
2087         (pane-list nil)
2088         (iter 0))
2089     (while entries
2090       (let (lst
2091             (count 0))
2092         (while (and (< count f-height) entries)
2093           (let ((str (car entries)))
2094             (push (cons
2095                    (if (> (length str) bookmark-menu-length)
2096                        (substring str 0 bookmark-menu-length)
2097                      str)
2098                    str)
2099                   lst)
2100             (setq entries (cdr entries))
2101             (setq count (1+ count))))
2102         (setq iter (1+ iter))
2103         (push (cons
2104                (format "-*- %s (%d) -*-" name iter)
2105                (nreverse lst))
2106               pane-list)))
2107
2108     ;; Popup the menu and return the string.
2109     (x-popup-menu event (cons (concat "-*- " name " -*-")
2110                               (nreverse pane-list)))))
2111
2112
2113 ;; Thanks to Roland McGrath for fixing menubar.el so that the
2114 ;; following works, and for explaining what to do to make it work.
2115
2116 ;; We MUST autoload EACH form used to set up this variable's value, so
2117 ;; that the whole job is done in loaddefs.el.
2118
2119 ;; Emacs menubar stuff.
2120
2121 ;;;###autoload
2122 (defvar menu-bar-bookmark-map
2123   (let ((map (make-sparse-keymap "Bookmark functions")))
2124     (define-key map [load]      '("Load a Bookmark File..." . bookmark-load))
2125     (define-key map [write]     '("Save Bookmarks As..." . bookmark-write))
2126     (define-key map [save]      '("Save Bookmarks" . bookmark-save))
2127     (define-key map [edit]      '("Edit Bookmark List" . bookmark-bmenu-list))
2128     (define-key map [delete]    '("Delete Bookmark..." . bookmark-delete))
2129     (define-key map [rename]    '("Rename Bookmark..." . bookmark-rename))
2130     (define-key map [locate]    '("Insert Location..." . bookmark-locate))
2131     (define-key map [insert]    '("Insert Contents..." . bookmark-insert))
2132     (define-key map [set]       '("Set Bookmark..." . bookmark-set))
2133     (define-key map [jump]      '("Jump to Bookmark..." . bookmark-jump))
2134     map))
2135
2136 ;;;###autoload
2137 (defalias 'menu-bar-bookmark-map menu-bar-bookmark-map)
2138
2139 ;; make bookmarks appear toward the right side of the menu.
2140 (if (boundp 'menu-bar-final-items)
2141     (if menu-bar-final-items
2142         (setq menu-bar-final-items
2143               (cons 'bookmark menu-bar-final-items)))
2144   (setq menu-bar-final-items '(bookmark)))
2145
2146 ;;;; end bookmark menu stuff ;;;;
2147
2148 \f
2149 ;;; Load Hook
2150 (defvar bookmark-load-hook nil
2151   "Hook run at the end of loading bookmark.")
2152
2153 ;;; Exit Hook, called from kill-emacs-hook
2154 (defvar bookmark-exit-hook nil
2155   "Hook run when Emacs exits.")
2156
2157 (define-obsolete-variable-alias 'bookmark-exit-hooks 'bookmark-exit-hook "22.1")
2158
2159 (defun bookmark-exit-hook-internal ()
2160   "Save bookmark state, if necessary, at Emacs exit time.
2161 This also runs `bookmark-exit-hook'."
2162   (run-hooks 'bookmark-exit-hook)
2163   (and bookmark-alist
2164        (bookmark-time-to-save-p t)
2165        (bookmark-save)))
2166
2167 (add-hook 'kill-emacs-hook 'bookmark-exit-hook-internal)
2168
2169
2170 (run-hooks 'bookmark-load-hook)
2171
2172 (provide 'bookmark)
2173
2174 ;;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
2175 ;;; bookmark.el ends here