bookmark.el

;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later

;; Copyright (C) 1993-1997, 2001-2011  Free Software Foundation, Inc.

;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
;; Created: July, 1993
;; Keywords: bookmarks, placeholders, annotations

;; This file is part of GNU Emacs.

;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; This package is for setting "bookmarks" in files.  A bookmark
;; associates a string with a location in a certain file.  Thus, you
;; can navigate your way to that location by providing the string.
;; See the "User Variables" section for customizations.


;;; Code:

(require 'pp)
(eval-when-compile (require 'cl))

;;; Misc comments:
;;
;; If variable bookmark-use-annotations is non-nil, an annotation is
;; queried for when setting a bookmark.
;;
;; The bookmark list is sorted lexically by default, but you can turn
;; this off by setting bookmark-sort-flag to nil.  If it is nil, then
;; the list will be presented in the order it is recorded
;; (chronologically), which is actually fairly useful as well.

;;; User Variables

(defgroup bookmark nil
  "Setting, annotation and jumping to bookmarks."
  :group 'matching)


(defcustom bookmark-use-annotations nil
  "If non-nil, saving a bookmark queries for an annotation in a buffer."
  :type 'boolean
  :group 'bookmark)


(defcustom bookmark-save-flag t
  "Controls when Emacs saves bookmarks to a file.
--> nil means never save bookmarks, except when `bookmark-save' is
    explicitly called (\\[bookmark-save]).
--> t means save bookmarks when Emacs is killed.
--> Otherwise, it should be a number that is the frequency with which
    the bookmark list is saved (i.e.: the number of times which
    Emacs' bookmark list may be modified before it is automatically
    saved.).  If it is a number, Emacs will also automatically save
    bookmarks when it is killed.

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

To specify the file in which to save them, modify the variable
`bookmark-default-file', which is `~/.emacs.bmk' by default."
  :type '(choice (const nil) integer (other t))
  :group 'bookmark)


(defconst bookmark-old-default-file "~/.emacs-bkmrks"
  "The `.emacs.bmk' file used to be called this name.")


;; defvarred to avoid a compilation warning:
(defvar bookmark-file nil
  "Old name for `bookmark-default-file'.")

(defcustom bookmark-default-file
  (if bookmark-file
      ;; In case user set `bookmark-file' in her .emacs:
      bookmark-file
    (locate-user-emacs-file "bookmarks" ".emacs.bmk"))
  "File in which to save bookmarks by default."
  :type 'file
  :group 'bookmark)


(defcustom bookmark-version-control 'nospecial
  "Whether or not to make numbered backups of the bookmark file.
It can have four values: t, nil, `never', and `nospecial'.
The first three have the same meaning that they do for the
variable `version-control', and the final value `nospecial' means just
use the value of `version-control'."
  :type '(choice (const nil) (const never) (const nospecial)
		 (other t))
  :group 'bookmark)


(defcustom bookmark-completion-ignore-case t
  "Non-nil means bookmark functions ignore case in completion."
  :type 'boolean
  :group 'bookmark)


(defcustom bookmark-sort-flag t
  "Non-nil means that bookmarks will be displayed sorted by bookmark name.
Otherwise they will be displayed in LIFO order (that is, most
recently set ones come first, oldest ones come last)."
  :type 'boolean
  :group 'bookmark)


(defcustom bookmark-automatically-show-annotations t
  "Non-nil means show annotations when jumping to a bookmark."
  :type 'boolean
  :group 'bookmark)


(defconst bookmark-bmenu-header-height 2
  "Number of lines used for the *Bookmark List* header.")

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

(defcustom bookmark-bmenu-file-column 30
  "Column at which to display filenames in a buffer listing bookmarks.
You can toggle whether files are shown with \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-toggle-filenames]."
  :type 'integer
  :group 'bookmark)


(defcustom bookmark-bmenu-toggle-filenames t
  "Non-nil means show filenames when listing bookmarks.
This may result in truncated bookmark names.  To disable this, put the
following in your `.emacs' file:

\(setq bookmark-bmenu-toggle-filenames nil)"
  :type 'boolean
  :group 'bookmark)


(defcustom bookmark-menu-length 70
  "Maximum length of a bookmark name displayed on a popup menu."
  :type 'integer
  :group 'bookmark)

;; FIXME: Is it really worth a customization option?
(defcustom bookmark-search-delay 0.2
  "Time before `bookmark-bmenu-search' updates the display."
  :group 'bookmark
  :type  'integer)

(defface bookmark-menu-heading
  '((t (:inherit font-lock-type-face)))
  "Face used to highlight the heading in bookmark menu buffers."
  :group 'bookmark
  :version "22.1")


;;; No user-serviceable parts beyond this point.

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

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


;;; Keymap stuff:

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

;;;###autoload (define-key ctl-x-r-map "b" 'bookmark-jump)
;;;###autoload (define-key ctl-x-r-map "m" 'bookmark-set)
;;;###autoload (define-key ctl-x-r-map "l" 'bookmark-bmenu-list)

;;;###autoload
(defvar bookmark-map
  (let ((map (make-sparse-keymap)))
    ;; Read the help on all of these functions for details...
    (define-key map "x" 'bookmark-set)
    (define-key map "m" 'bookmark-set) ;"m"ark
    (define-key map "j" 'bookmark-jump)
    (define-key map "g" 'bookmark-jump) ;"g"o
    (define-key map "o" 'bookmark-jump-other-window)
    (define-key map "i" 'bookmark-insert)
    (define-key map "e" 'edit-bookmarks)
    (define-key map "f" 'bookmark-insert-location) ;"f"ind
    (define-key map "r" 'bookmark-rename)
    (define-key map "d" 'bookmark-delete)
    (define-key map "l" 'bookmark-load)
    (define-key map "w" 'bookmark-write)
    (define-key map "s" 'bookmark-save)
    map)
  "Keymap containing bindings to bookmark functions.
It is not bound to any key by default: to bind it
so that you have a bookmark prefix, just use `global-set-key' and bind a
key of your choice to `bookmark-map'.  All interactive bookmark
functions have a binding in this keymap.")

;;;###autoload (fset 'bookmark-map bookmark-map)

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

The value is an alist with entries of the form

 (BOOKMARK-NAME . PARAM-ALIST)

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

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

 PARAM-ALIST is an alist of bookmark information.  The order of the
 entries in PARAM-ALIST is not important.  The possible entries are
 described below.  An entry with a key but null value means the entry
 is not used.

  (filename . FILENAME)
  (position . POS)
  (front-context-string . STR-AFTER-POS)
  (rear-context-string  . STR-BEFORE-POS)
  (handler . HANDLER)
  (annotation . ANNOTATION)

 FILENAME names the bookmarked file.
 POS is the bookmarked buffer position (position in the file).
 STR-AFTER-POS is buffer text that immediately follows POS.
 STR-BEFORE-POS is buffer text that immediately precedes POS.
 ANNOTATION is a string that describes the bookmark.
   See options `bookmark-use-annotations' and
   `bookmark-automatically-show-annotations'.
 HANDLER is a function that provides the bookmark-jump behavior for a
 specific kind of bookmark.  This is the case for Info bookmarks,
 for instance.  HANDLER must accept a bookmark as argument.")

(defvar bookmarks-already-loaded nil
  "Non-nil if and only if bookmarks have been loaded from `bookmark-default-file'.")


;; more stuff added by db.

(defvar bookmark-current-bookmark nil
  "Name of bookmark most recently used in the current file.
It is buffer local, used to make moving a bookmark forward
through a file easier.")

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


(defvar bookmark-alist-modification-count 0
  "Number of modifications to bookmark list since it was last saved.")


(defvar bookmark-search-size 16
  "Length of the context strings recorded on either side of a bookmark.")


(defvar bookmark-current-buffer nil
  "The buffer in which a bookmark is currently being set or renamed.
Functions that insert strings into the minibuffer use this to know
the source buffer for that information; see `bookmark-yank-word' and
`bookmark-insert-current-bookmark' for example.")


(defvar bookmark-yank-point 0
  "The next point from which to pull source text for `bookmark-yank-word'.
This point is in `bookmark-current-buffer'.")


(defvar bookmark-quit-flag nil
  "Non nil make `bookmark-bmenu-search' quit immediately.")

;; Helper functions and macros.

(defmacro with-buffer-modified-unmodified (&rest body)
  "Run BODY while preserving the buffer's `buffer-modified-p' state."
  (let ((was-modified (make-symbol "was-modified")))
    `(let ((,was-modified (buffer-modified-p)))
       (unwind-protect
           (progn ,@body)
         (set-buffer-modified-p ,was-modified)))))

;; Only functions below, in this page and the next one (file formats),
;; need to know anything about the format of bookmark-alist entries.
;; Everyone else should go through them.

(defun bookmark-name-from-full-record (bookmark-record)
  "Return the name of BOOKMARK-RECORD.  BOOKMARK-RECORD is, e.g.,
one element from `bookmark-alist'."
  (car bookmark-record))


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


(defun bookmark-get-bookmark (bookmark-name-or-record &optional noerror)
  "Return the bookmark record corresponding to BOOKMARK-NAME-OR-RECORD.
If BOOKMARK-NAME-OR-RECORD is a string, look for the corresponding
bookmark record in `bookmark-alist'; return it if found, otherwise
error.  Else if BOOKMARK-NAME-OR-RECORD is already a bookmark record,
just return it."
  (cond
   ((consp bookmark-name-or-record) bookmark-name-or-record)
   ((stringp bookmark-name-or-record)
    (or (assoc-string bookmark-name-or-record bookmark-alist
                      bookmark-completion-ignore-case)
        (unless noerror (error "Invalid bookmark %s"
                               bookmark-name-or-record))))))


(defun bookmark-get-bookmark-record (bookmark-name-or-record)
  "Return the record portion of the entry for BOOKMARK-NAME-OR-RECORD in
`bookmark-alist' (that is, all information but the name)."
  (let ((alist (cdr (bookmark-get-bookmark bookmark-name-or-record))))
    ;; The bookmark objects can either look like (NAME ALIST) or
    ;; (NAME . ALIST), so we have to distinguish the two here.
    (if (and (null (cdr alist)) (consp (caar alist)))
        (car alist) alist)))


(defun bookmark-set-name (bookmark-name-or-record newname)
  "Set BOOKMARK-NAME-OR-RECORD's name to NEWNAME."
  (setcar (bookmark-get-bookmark bookmark-name-or-record) newname))

(defun bookmark-prop-get (bookmark-name-or-record prop)
  "Return the property PROP of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (cdr (assq prop (bookmark-get-bookmark-record bookmark-name-or-record))))

(defun bookmark-prop-set (bookmark-name-or-record prop val)
  "Set the property PROP of BOOKMARK-NAME-OR-RECORD to VAL."
  (let ((cell (assq
               prop (bookmark-get-bookmark-record bookmark-name-or-record))))
    (if cell
        (setcdr cell val)
      (nconc (bookmark-get-bookmark-record bookmark-name-or-record)
             (list (cons prop val))))))

(defun bookmark-get-annotation (bookmark-name-or-record)
  "Return the annotation of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'annotation))

(defun bookmark-set-annotation (bookmark-name-or-record ann)
  "Set the annotation of BOOKMARK-NAME-OR-RECORD to ANN."
  (bookmark-prop-set bookmark-name-or-record 'annotation ann))


(defun bookmark-get-filename (bookmark-name-or-record)
  "Return the full filename of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'filename))


(defun bookmark-set-filename (bookmark-name-or-record filename)
  "Set the full filename of BOOKMARK-NAME-OR-RECORD to FILENAME."
  (bookmark-prop-set bookmark-name-or-record 'filename filename))


(defun bookmark-get-position (bookmark-name-or-record)
  "Return the position (i.e.: point) of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'position))


(defun bookmark-set-position (bookmark-name-or-record position)
  "Set the position (i.e.: point) of BOOKMARK-NAME-OR-RECORD to POSITION."
  (bookmark-prop-set bookmark-name-or-record 'position position))


(defun bookmark-get-front-context-string (bookmark-name-or-record)
  "Return the front-context-string of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'front-context-string))


(defun bookmark-set-front-context-string (bookmark-name-or-record string)
  "Set the front-context-string of BOOKMARK-NAME-OR-RECORD to STRING."
  (bookmark-prop-set bookmark-name-or-record 'front-context-string string))


(defun bookmark-get-rear-context-string (bookmark-name-or-record)
  "Return the rear-context-string of BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'rear-context-string))


(defun bookmark-set-rear-context-string (bookmark-name-or-record string)
  "Set the rear-context-string of BOOKMARK-NAME-OR-RECORD to STRING."
  (bookmark-prop-set bookmark-name-or-record 'rear-context-string string))


(defun bookmark-get-handler (bookmark-name-or-record)
  "Return the handler function for BOOKMARK-NAME-OR-RECORD, or nil if none."
  (bookmark-prop-get bookmark-name-or-record 'handler))

(defvar bookmark-history nil
  "The history list for bookmark functions.")


(defun bookmark-completing-read (prompt &optional default)
  "Prompting with PROMPT, read a bookmark name in completion.
PROMPT will get a \": \" stuck on the end no matter what, so you
probably don't want to include one yourself.
Optional second arg DEFAULT is a string to return if the user enters
the empty string."
  (bookmark-maybe-load-default-file) ; paranoia
  (if (listp last-nonmenu-event)
      (bookmark-menu-popup-paned-menu t prompt
				      (if bookmark-sort-flag
					  (sort (bookmark-all-names)
						'string-lessp)
					(bookmark-all-names)))
    (let* ((completion-ignore-case bookmark-completion-ignore-case)
	   (default default)
	   (prompt (concat prompt (if default
                                      (format " (%s): " default)
                                    ": ")))
	   (str
	    (completing-read prompt
			     bookmark-alist
			     nil
			     0
			     nil
			     'bookmark-history)))
      (if (string-equal "" str) default str))))


(defmacro bookmark-maybe-historicize-string (string)
  "Put STRING into the bookmark prompt history, if caller non-interactive.
We need this because sometimes bookmark functions are invoked from
menus, so `completing-read' never gets a chance to set `bookmark-history'."
  `(or
    (called-interactively-p 'interactive)
    (setq bookmark-history (cons ,string bookmark-history))))

(defvar bookmark-make-record-function 'bookmark-make-record-default
  "A function that should be called to create a bookmark record.
Modes may set this variable buffer-locally to enable bookmarking of
locations that should be treated specially, such as Info nodes,
news posts, images, pdf documents, etc.

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

The returned record should be a cons cell of the form (NAME . ALIST)
where ALIST is as described in `bookmark-alist' and may typically contain
a special cons (handler . HANDLER-FUNC) which specifies the handler function
that should be used instead of `bookmark-default-handler' to open this
bookmark.  See the documentation for `bookmark-alist' for more.

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

(defun bookmark-make-record ()
  "Return a new bookmark record (NAME . ALIST) for the current location."
  (let ((record (funcall bookmark-make-record-function)))
    ;; Set up default name.
    (if (stringp (car record))
        ;; The function already provided a default name.
        record
      (if (car record) (push nil record))
      (setcar record (or bookmark-current-bookmark (bookmark-buffer-name)))
      record)))

(defun bookmark-store (name alist no-overwrite)
  "Store the bookmark NAME with data ALIST.
If NO-OVERWRITE is non-nil and another bookmark of the same name already
exists in `bookmark-alist', record the new bookmark without throwing away the
old one."
  (bookmark-maybe-load-default-file)
  (let ((stripped-name (copy-sequence name)))
    (or (featurep 'xemacs)
        ;; XEmacs's `set-text-properties' doesn't work on
        ;; free-standing strings, apparently.
        (set-text-properties 0 (length stripped-name) nil stripped-name))
    (if (and (not no-overwrite)
             (bookmark-get-bookmark stripped-name 'noerror))
        ;; already existing bookmark under that name and
        ;; no prefix arg means just overwrite old bookmark
        ;; Use the new (NAME . ALIST) format.
        (setcdr (bookmark-get-bookmark stripped-name) alist)

      ;; otherwise just cons it onto the front (either the bookmark
      ;; doesn't exist already, or there is no prefix arg.  In either
      ;; case, we want the new bookmark consed onto the alist...)

      (push (cons stripped-name alist) bookmark-alist))

    ;; Added by db
    (setq bookmark-current-bookmark stripped-name)
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
    (if (bookmark-time-to-save-p)
        (bookmark-save))

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

(defun bookmark-make-record-default (&optional no-file no-context posn)
  "Return the record describing the location of a new bookmark.
Point should be at the buffer in which the bookmark is being set,
and normally should be at the position where the bookmark is desired,
but see the optional arguments for other possibilities.

If NO-FILE is non-nil, then only return the subset of the
record that pertains to the location within the buffer, leaving off
the part that records the filename.

If NO-CONTEXT is non-nil, do not include the front- and rear-context
strings in the record -- the position is enough.

If POSN is non-nil, record POSN as the point instead of `(point)'."
  `(,@(unless no-file `((filename . ,(bookmark-buffer-file-name))))
    ,@(unless no-context `((front-context-string
                           . ,(if (>= (- (point-max) (point))
                                      bookmark-search-size)
                                  (buffer-substring-no-properties
                                   (point)
                                   (+ (point) bookmark-search-size))
                                  nil))))
    ,@(unless no-context `((rear-context-string
                           . ,(if (>= (- (point) (point-min))
                                      bookmark-search-size)
                                  (buffer-substring-no-properties
                                   (point)
                                   (- (point) bookmark-search-size))
                                  nil))))
    (position . ,(or posn (point)))))


;;; File format stuff

;; *IMPORTANT NOTICE* If you are thinking about modifying (redefining)
;; the bookmark file format -- please don't.  The current format
;; should be extensible enough.  If you feel the need to change it,
;; please discuss it with other Emacs developers first.
;;
;; The format of `bookmark-alist' has changed twice in its lifetime.
;; This comment describes the three formats, FIRST, SECOND, and
;; CURRENT.
;;
;; The FIRST format was used prior to Emacs 20:
;;
;;       ((BOOKMARK-NAME (FILENAME
;;                          STRING-IN-FRONT
;;                          STRING-BEHIND
;;                          POINT))
;;        ...)
;;
;; The SECOND format was introduced in Emacs 20:
;;
;;       ((BOOKMARK-NAME ((filename   . FILENAME)
;;                        (position   . POS)
;;                        (front-context-string . STR-AFTER-POS)
;;                        (rear-context-string  . STR-BEFORE-POS)
;;                        (annotation . ANNOTATION)
;;                        (whatever   . VALUE)
;;                        ...
;;                       ))
;;        ...)
;;
;; The CURRENT format was introduced in Emacs 22:
;;
;;       ((BOOKMARK-NAME (filename   . FILENAME)
;;                       (position   . POS)
;;                       (front-context-string . STR-AFTER-POS)
;;                       (rear-context-string  . STR-BEFORE-POS)
;;                       (annotation . ANNOTATION)
;;                       (whatever   . VALUE)
;;                       ...
;;                       )
;;        ...)
;;
;; Both FIRST and SECOND have the same level of nesting: the cadr of a
;; bookmark record is a list of entry information.  FIRST and SECOND
;; differ in the form of the record information: FIRST uses a list of
;; atoms, and SECOND uses an alist.  In the FIRST format, the order of
;; the list elements matters.  In the SECOND format, the order of the
;; alist elements is unimportant.  The SECOND format facilitates the
;; addition of new kinds of elements, to support new kinds of
;; bookmarks or code evolution.
;;
;; The CURRENT format removes a level of nesting wrt FIRST and SECOND,
;; saving one cons cell per bookmark: the cadr of a bookmark record is
;; no longer a cons.  Why that change was made remains a mystery --
;; just be aware of it.  (Be aware too that this explanatory comment
;; was incorrect in Emacs 22 and Emacs 23.1.)
;;
;; To deal with the change from FIRST format to SECOND, conversion
;; code was added, and it is still in use.  See
;; `bookmark-maybe-upgrade-file-format'.
;;
;; No conversion from SECOND to CURRENT is done.  Instead, the code
;; handles both formats OK.  It must continue to do so.
;;
;; See the doc string of `bookmark-alist' for information about the
;; elements that define a bookmark (e.g. `filename').


(defconst bookmark-file-format-version 1
  "The current version of the format used by bookmark files.
You should never need to change this.")


(defconst bookmark-end-of-version-stamp-marker
  "-*- End Of Bookmark File Format Version Stamp -*-\n"
  "This string marks the end of the version stamp in a bookmark file.")


(defun bookmark-alist-from-buffer ()
  "Return a `bookmark-alist' (in any format) from the current buffer.
The buffer must of course contain bookmark format information.
Does not care from where in the buffer it is called, and does not
affect point."
  (save-excursion
    (goto-char (point-min))
    (if (search-forward bookmark-end-of-version-stamp-marker nil t)
        (read (current-buffer))
      ;; Else we're dealing with format version 0
      (if (search-forward "(" nil t)
          (progn
            (forward-char -1)
            (read (current-buffer)))
        ;; Else no hope of getting information here.
        (error "Not bookmark format")))))


(defun bookmark-upgrade-version-0-alist (old-list)
  "Upgrade a version 0 alist OLD-LIST to the current version."
  (mapcar
   (lambda (bookmark)
     (let* ((name      (car bookmark))
            (record    (car (cdr bookmark)))
            (filename  (nth 0 record))
            (front-str (nth 1 record))
            (rear-str  (nth 2 record))
            (position  (nth 3 record))
            (ann       (nth 4 record)))
       (list
        name
        `((filename             .    ,filename)
          (front-context-string .    ,(or front-str ""))
          (rear-context-string  .    ,(or rear-str  ""))
          (position             .    ,position)
          (annotation           .    ,ann)))))
   old-list))


(defun bookmark-upgrade-file-format-from-0 ()
  "Upgrade a bookmark file of format 0 (the original format) to format 1.
This expects to be called from `point-min' in a bookmark file."
  (message "Upgrading bookmark format from 0 to %d..."
           bookmark-file-format-version)
  (let* ((old-list (bookmark-alist-from-buffer))
         (new-list (bookmark-upgrade-version-0-alist old-list)))
    (delete-region (point-min) (point-max))
    (bookmark-insert-file-format-version-stamp)
    (pp new-list (current-buffer))
    (save-buffer))
  (goto-char (point-min))
  (message "Upgrading bookmark format from 0 to %d...done"
           bookmark-file-format-version)
  )


(defun bookmark-grok-file-format-version ()
  "Return an integer which is the file-format version of this bookmark file.
This expects to be called from `point-min' in a bookmark file."
  (if (looking-at "^;;;;")
      (save-excursion
        (save-match-data
          (re-search-forward "[0-9]")
          (forward-char -1)
          (read (current-buffer))))
    ;; Else this is format version 0, the original one, which didn't
    ;; even have version stamps.
    0))


(defun bookmark-maybe-upgrade-file-format ()
  "Check the file-format version of this bookmark file.
If the version is not up-to-date, upgrade it automatically.
This expects to be called from `point-min' in a bookmark file."
  (let ((version (bookmark-grok-file-format-version)))
    (cond
     ((= version bookmark-file-format-version)
      ) ; home free -- version is current
     ((= version 0)
      (bookmark-upgrade-file-format-from-0))
     (t
      (error "Bookmark file format version strangeness")))))


(defun bookmark-insert-file-format-version-stamp ()
  "Insert text indicating current version of bookmark file format."
  (insert
   (format ";;;; Emacs Bookmark Format Version %d ;;;;\n"
           bookmark-file-format-version))
  (insert ";;; This format is meant to be slightly human-readable;\n"
          ";;; nevertheless, you probably don't want to edit it.\n"
          ";;; "
          bookmark-end-of-version-stamp-marker))


;;; end file-format stuff


;;; Generic helpers.

(defun bookmark-maybe-message (fmt &rest args)
  "Apply `message' to FMT and ARGS, but only if the display is fast enough."
  (if (>= baud-rate 9600)
      (apply 'message fmt args)))


;;; Core code:

(defvar bookmark-minibuffer-read-name-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map minibuffer-local-map)
    (define-key map "\C-w" 'bookmark-yank-word)
    ;; This C-u binding might not be very useful any more now that we
    ;; provide access to the default via the standard M-n binding.
    ;; Maybe we should just remove it?  --Stef-08
    (define-key map "\C-u" 'bookmark-insert-current-bookmark)
    map))

;;;###autoload
(defun bookmark-set (&optional name no-overwrite)
  "Set a bookmark named NAME at the current location.
If name is nil, then prompt the user.

With a prefix arg (non-nil NO-OVERWRITE), do not overwrite any
existing bookmark that has the same name as NAME, but instead push the
new bookmark onto the bookmark alist.  The most recently set bookmark
with name NAME is thus the one in effect at any given time, but the
others are still there, should the user decide to delete the most
recent one.

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

Typing C-u inserts (at the bookmark name prompt) the name of the last
bookmark used in the document where the new bookmark is being set;
this helps you use a single bookmark name to track progress through a
large document.  If there is no prior bookmark for this document, then
C-u inserts an appropriate name based on the buffer or file.

Use \\[bookmark-delete] to remove bookmarks (you give it a name and
it removes only the first instance of a bookmark with that name from
the list of bookmarks.)"
  (interactive (list nil current-prefix-arg))
  (unwind-protect
       (let* ((record (bookmark-make-record))
              (default (car record)))

         (bookmark-maybe-load-default-file)
         ;; Don't set `bookmark-yank-point' and `bookmark-current-buffer'
         ;; if they have been already set in another buffer. (e.g gnus-art).
         (unless (and bookmark-yank-point
                      bookmark-current-buffer)
           (setq bookmark-yank-point (point))
           (setq bookmark-current-buffer (current-buffer)))

         (let ((str
                (or name
                    (read-from-minibuffer
                     (format "Set bookmark (%s): " default)
                     nil
                     bookmark-minibuffer-read-name-map
                     nil nil default))))
           (and (string-equal str "") (setq str default))
           (bookmark-store str (cdr record) no-overwrite)

           ;; Ask for an annotation buffer for this bookmark
           (when bookmark-use-annotations
             (bookmark-edit-annotation str))))
    (setq bookmark-yank-point nil)
    (setq bookmark-current-buffer nil)))


(defun bookmark-kill-line (&optional newline-too)
  "Kill from point to end of line.
If optional arg NEWLINE-TOO is non-nil, delete the newline too.
Does not affect the kill ring."
  (let ((eol (line-end-position)))
    (delete-region (point) eol)
    (if (and newline-too (looking-at "\n"))
        (delete-char 1))))


;; Defvars to avoid compilation warnings:
(defvar bookmark-annotation-name nil
  "Variable holding the name of the bookmark.
This is used in `bookmark-edit-annotation' to record the bookmark
whose annotation is being edited.")


(defun bookmark-default-annotation-text (bookmark-name)
  "Return default annotation text for BOOKMARK-NAME.
The default annotation text is simply some text explaining how to use
annotations."
  (concat "#  Type the annotation for bookmark '" bookmark-name "' here.\n"
	  "#  All lines which start with a '#' will be deleted.\n"
	  "#  Type C-c C-c when done.\n#\n"
	  "#  Author: " (user-full-name) " <" (user-login-name) "@"
	  (system-name) ">\n"
	  "#  Date:    " (current-time-string) "\n"))


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

(defvar bookmark-edit-annotation-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map text-mode-map)
    (define-key map "\C-c\C-c" 'bookmark-send-edited-annotation)
    map)
  "Keymap for editing an annotation of a bookmark.")


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

\\{bookmark-edit-annotation-mode-map}"
  (interactive)
  (kill-all-local-variables)
  (make-local-variable 'bookmark-annotation-name)
  (setq bookmark-annotation-name bookmark-name-or-record)
  (use-local-map bookmark-edit-annotation-mode-map)
  (setq major-mode 'bookmark-edit-annotation-mode
        mode-name "Edit Bookmark Annotation")
  (insert (funcall bookmark-edit-annotation-text-func bookmark-name-or-record))
  (let ((annotation (bookmark-get-annotation bookmark-name-or-record)))
    (if (and annotation (not (string-equal annotation "")))
	(insert annotation)))
  (run-mode-hooks 'text-mode-hook))


(defun bookmark-send-edited-annotation ()
  "Use buffer contents as annotation for a bookmark.
Lines beginning with `#' are ignored."
  (interactive)
  (if (not (eq major-mode 'bookmark-edit-annotation-mode))
      (error "Not in bookmark-edit-annotation-mode"))
  (goto-char (point-min))
  (while (< (point) (point-max))
    (if (looking-at "^#")
        (bookmark-kill-line t)
      (forward-line 1)))
  ;; Take no chances with text properties.
  (let ((annotation (buffer-substring-no-properties (point-min) (point-max)))
	(bookmark-name bookmark-annotation-name))
    (bookmark-set-annotation bookmark-name annotation)
    (setq bookmark-alist-modification-count
          (1+ bookmark-alist-modification-count))
    (bookmark-bmenu-surreptitiously-rebuild-list))
  (kill-buffer (current-buffer)))


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


(defun bookmark-insert-current-bookmark ()
  "Insert into the bookmark name currently being set the value of
`bookmark-current-bookmark' in `bookmark-current-buffer', defaulting
to the buffer's file name if `bookmark-current-bookmark' is nil."
  (interactive)
  (let ((str
	 (with-current-buffer bookmark-current-buffer
	   (or bookmark-current-bookmark
               (bookmark-buffer-name)))))
    (insert str)))


(defun bookmark-buffer-name ()
  "Return the name of the current buffer in a form usable as a bookmark name.
If the buffer is associated with a file or directory, use that name."
  (cond
   ;; Or are we a file?
   (buffer-file-name (file-name-nondirectory buffer-file-name))
   ;; Or are we a directory?
   ((and (boundp 'dired-directory) dired-directory)
    (let* ((dirname (if (stringp dired-directory)
                        dired-directory
                      (car dired-directory)))
           (idx (1- (length dirname))))
      ;; Strip the trailing slash.
      (if (= ?/ (aref dirname idx))
          (file-name-nondirectory (substring dirname 0 idx))
        ;; Else return the current-buffer
        (buffer-name (current-buffer)))))
   ;; If all else fails, use the buffer's name.
   (t
    (buffer-name (current-buffer)))))


(defun bookmark-yank-word ()
  "Get the next word from buffer `bookmark-current-buffer' and append
it to the name of the bookmark currently being set, advancing
`bookmark-yank-point' by one word."
  (interactive)
  (let ((string (with-current-buffer bookmark-current-buffer
                  (goto-char bookmark-yank-point)
                  (buffer-substring-no-properties
                   (point)
                   (progn
                     (forward-word 1)
                     (setq bookmark-yank-point (point)))))))
    (insert string)))

(defun bookmark-buffer-file-name ()
  "Return the current buffer's file in a way useful for bookmarks."
  ;; Abbreviate the path, both so it's shorter and so it's more
  ;; portable.  E.g., the user's home dir might be a different
  ;; path on different machines, but "~/" will still reach it.
  (abbreviate-file-name
   (cond
    (buffer-file-name buffer-file-name)
    ((and (boundp 'dired-directory) dired-directory)
     (if (stringp dired-directory)
         dired-directory
       (car dired-directory)))
    (t (error "Buffer not visiting a file or directory")))))


(defun bookmark-maybe-load-default-file ()
  "If bookmarks have not been loaded from the default place, load them."
  (and (not bookmarks-already-loaded)
       (null bookmark-alist)
       (prog2
           (and
            ;; Possibly the old bookmark file, "~/.emacs-bkmrks", needs
            ;; to be renamed.
            (file-exists-p bookmark-old-default-file)
            (not (file-exists-p bookmark-default-file))
            (rename-file bookmark-old-default-file
                         bookmark-default-file))
           ;; return t so the `and' will continue...
           t)

       (file-readable-p bookmark-default-file)
       (bookmark-load bookmark-default-file t t)
       (setq bookmarks-already-loaded t)))


(defun bookmark-maybe-sort-alist ()
  "Return `bookmark-alist' for display.
If `bookmark-sort-flag' is non-nil, then return a sorted copy of the alist."
  (if bookmark-sort-flag
      (sort (copy-alist bookmark-alist)
            (function
             (lambda (x y) (string-lessp (car x) (car y)))))
    bookmark-alist))


(defvar bookmark-after-jump-hook nil
  "Hook run after `bookmark-jump' jumps to a bookmark.
Useful for example to unhide text in `outline-mode'.")

(defun bookmark--jump-via (bookmark-name-or-record display-function)
  "Handle BOOKMARK-NAME-OR-RECORD, then call DISPLAY-FUNCTION with
current buffer as argument.

After calling DISPLAY-FUNCTION, set window point to the point specified