+
+\f
+;; Helper functions.
+
+;; Only functions on 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 (full-record)
+ "Return name of FULL-RECORD \(an alist element instead of a string\)."
+ (car full-record))
+
+
+(defun bookmark-all-names ()
+ "Return a list of all current bookmark names."
+ (bookmark-maybe-load-default-file)
+ (mapcar
+ (lambda (full-record)
+ (bookmark-name-from-full-record full-record))
+ bookmark-alist))
+
+
+(defun bookmark-get-bookmark (bookmark)
+ "Return the full entry for BOOKMARK in bookmark-alist."
+ (assoc bookmark bookmark-alist))
+
+
+(defun bookmark-get-bookmark-record (bookmark)
+ "Return the guts of the entry for BOOKMARK in bookmark-alist.
+That is, all information but the name."
+ (car (cdr (bookmark-get-bookmark bookmark))))
+
+
+(defun bookmark-set-name (bookmark newname)
+ "Set BOOKMARK's name to NEWNAME."
+ (setcar
+ (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
+ newname))
+
+
+(defun bookmark-get-annotation (bookmark)
+ "Return the annotation of BOOKMARK, or nil if none."
+ (cdr (assq 'annotation (bookmark-get-bookmark-record bookmark))))
+
+
+(defun bookmark-set-annotation (bookmark ann)
+ "Set the annotation of BOOKMARK to ANN."
+ (let ((cell (assq 'annotation (bookmark-get-bookmark-record bookmark))))
+ (if cell
+ (setcdr cell ann)
+ (nconc (bookmark-get-bookmark-record bookmark)
+ (list (cons 'annotation ann))))))
+
+
+(defun bookmark-get-filename (bookmark)
+ "Return the full filename of BOOKMARK."
+ (cdr (assq 'filename (bookmark-get-bookmark-record bookmark))))
+
+
+(defun bookmark-set-filename (bookmark filename)
+ "Set the full filename of BOOKMARK to FILENAME."
+ (let ((cell (assq 'filename (bookmark-get-bookmark-record bookmark))))
+ (if cell
+ (setcdr cell filename)
+ (nconc (bookmark-get-bookmark-record bookmark)
+ (list (cons 'filename filename))))))
+
+
+(defun bookmark-get-position (bookmark)
+ "Return the position \(i.e.: point\) of BOOKMARK."
+ (cdr (assq 'position (bookmark-get-bookmark-record bookmark))))
+
+
+(defun bookmark-set-position (bookmark position)
+ "Set the position \(i.e.: point\) of BOOKMARK to POSITION."
+ (let ((cell (assq 'position (bookmark-get-bookmark-record bookmark))))
+ (if cell
+ (setcdr cell position)
+ (nconc (bookmark-get-bookmark-record bookmark)
+ (list (cons 'position position))))))
+
+
+(defun bookmark-get-front-context-string (bookmark)
+ "Return the front-context-string of BOOKMARK."
+ (cdr (assq 'front-context-string (bookmark-get-bookmark-record bookmark))))
+
+
+(defun bookmark-set-front-context-string (bookmark string)
+ "Set the front-context-string of BOOKMARK to STRING."
+ (let ((cell (assq 'front-context-string
+ (bookmark-get-bookmark-record bookmark))))
+ (if cell
+ (setcdr cell string)
+ (nconc (bookmark-get-bookmark-record bookmark)
+ (list (cons 'front-context-string string))))))
+
+
+(defun bookmark-get-rear-context-string (bookmark)
+ "Return the rear-context-string of BOOKMARK."
+ (cdr (assq 'rear-context-string (bookmark-get-bookmark-record bookmark))))
+
+
+(defun bookmark-set-rear-context-string (bookmark string)
+ "Set the rear-context-string of BOOKMARK to STRING."
+ (let ((cell (assq 'rear-context-string
+ (bookmark-get-bookmark-record bookmark))))
+ (if cell
+ (setcdr cell string)
+ (nconc (bookmark-get-bookmark-record bookmark)
+ (list (cons 'rear-context-string string))))))
+
+
+(defun bookmark-get-info-node (bookmark)
+ "Get the info node associated with BOOKMARK."
+ (cdr (assq 'info-node (bookmark-get-bookmark-record bookmark))))
+
+
+(defun bookmark-set-info-node (bookmark node)
+ "Set the Info node of BOOKMARK to NODE."
+ (let ((cell (assq 'info-node
+ (bookmark-get-bookmark-record bookmark))))
+ (if cell
+ (setcdr cell node)
+ (nconc (bookmark-get-bookmark-record bookmark)
+ (list (cons 'info-node node)))))
+
+ (message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
+ (sit-for 4)
+ )
+
+
+(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
+ (let* ((completion-ignore-case bookmark-completion-ignore-case)
+ (default default)
+ (prompt (if default
+ (concat prompt (format " (%s): " default))
+ (concat prompt ": ")))
+ (str
+ (completing-read prompt
+ bookmark-alist
+ nil
+ 0
+ nil
+ 'bookmark-history)))
+ (if (string-equal "" str)
+ (list default)
+ (list 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
+ (interactive-p)
+ (setq bookmark-history (cons (, string) bookmark-history)))))
+
+
+(defun bookmark-make (name &optional annotation overwrite info-node)
+ "Make a bookmark named NAME.
+Optional second arg ANNOTATION gives it an annotation.
+Optional third arg OVERWRITE means replace any existing bookmarks with
+this name.
+Optional fourth arg INFO-NODE means this bookmark is at info node
+INFO-NODE, so record this fact in the bookmark's entry."
+ (bookmark-maybe-load-default-file)
+ (let ((stripped-name (copy-sequence name)))
+ (or bookmark-xemacsp
+ ;; 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 (bookmark-get-bookmark stripped-name) (not overwrite))
+ ;; already existing bookmark under that name and
+ ;; no prefix arg means just overwrite old bookmark
+ (setcdr (bookmark-get-bookmark stripped-name)
+ (list (bookmark-make-cell annotation info-node)))
+
+ ;; 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...)
+
+ (setq bookmark-alist
+ (cons
+ (list stripped-name
+ (bookmark-make-cell annotation info-node))
+ 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))))
+
+
+(defun bookmark-make-cell (annotation &optional info-node)
+ "Return the record part of a new bookmark, given ANNOTATION.
+Must be at the correct position in the buffer in which the bookmark is
+being set. This might change someday.
+Optional second arg INFO-NODE means this bookmark is at info node
+INFO-NODE, so record this fact in the bookmark's entry."
+ (let ((the-record
+ (` ((filename . (, (bookmark-buffer-file-name)))
+ (front-context-string
+ . (, (if (>= (- (point-max) (point)) bookmark-search-size)
+ (buffer-substring-no-properties
+ (point)
+ (+ (point) bookmark-search-size))
+ nil)))
+ (rear-context-string
+ . (, (if (>= (- (point) (point-min)) bookmark-search-size)
+ (buffer-substring-no-properties
+ (point)
+ (- (point) bookmark-search-size))
+ nil)))
+ (position . (, (point)))
+ ))))
+
+ ;; Now fill in the optional parts:
+
+ ;; Take no chances with text properties
+ (set-text-properties 0 (length annotation) nil annotation)
+ (set-text-properties 0 (length info-node) nil info-node)
+
+ (if annotation
+ (nconc the-record (list (cons 'annotation annotation))))
+ (if info-node
+ (nconc the-record (list (cons 'info-node info-node))))
+
+ ;; Finally, return the completed record.
+ the-record))
+
+
+\f
+;;; File format stuff
+
+;; The OLD format of the bookmark-alist was:
+;;
+;; ((bookmark-name (filename
+;; string-in-front
+;; string-behind
+;; point))
+;; ...)
+;;
+;; The NEW format of the bookmark-alist is:
+;;
+;; ((bookmark-name ((filename . FILENAME)
+;; (front-context-string . string-in-front)
+;; (rear-context-string . string-behind)
+;; (position . POINT)
+;; (annotation . annotation)
+;; (whatever . VALUE)
+;; ...
+;; ))
+;; ...)
+;;
+;;
+;; I switched to using an internal as well as external alist because I
+;; felt that would be a more flexible framework in which to add
+;; features. It means that the order in which values appear doesn't
+;; matter, and it means that arbitrary values can be added without
+;; risk of interfering with existing ones.
+;;
+;; BOOKMARK-NAME is the string the user gives the bookmark and
+;; accesses it by from then on.
+;;
+;; FILENAME is the location of the file in which the bookmark is set.
+;;
+;; STRING-IN-FRONT is a string of `bookmark-search-size' chars of
+;; context in front of the point at which the bookmark is set.
+;;
+;; STRING-BEHIND is the same thing, but after the point.
+;;
+;; The context strings exist so that modifications to a file don't
+;; necessarily cause a bookmark's position to be invalidated.
+;; bookmark-jump will search for STRING-BEHIND and STRING-IN-FRONT in
+;; case the file has changed since the bookmark was set. It will
+;; attempt to place the user before the changes, if there were any.
+;; ANNOTATION is the annotation for the bookmark; it may not exist
+;; (for backward compatibility), be nil (no annotation), or be a
+;; string.
+
+
+(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
+
+\f
+;;; Core code:
+