;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later.
-;; Copyright (C) 1993, 1994, 1995, 1996, 1997 Free Software Foundation
+;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001 Free Software Foundation
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
;; Created: July, 1993
-;; Author's Update Number: see variable `bookmark-version'.
;; Keywords: bookmarks, placeholders, annotations
;; This file is part of GNU Emacs.
;; Enough with the credits already, get on to the good stuff:
-;; FAVORITE CHINESE RESTAURANT:
+;; FAVORITE CHINESE RESTAURANT:
;; Boy, that's a tough one. Probably Hong Min, or maybe Emperor's
;; Choice (both in Chicago's Chinatown). Well, both. How about you?
\f
(require 'pp)
-(defconst bookmark-version "2.6.4"
- "Version number of bookmark.el. This is not related to the version
-of Emacs bookmark comes with; it is used solely by bookmark's
-maintainers to avoid version confusion.")
-
;;; Misc comments:
;;
;; If variable bookmark-use-annotations is non-nil, an annotation is
-;; queried for when setting a bookmark.
+;; 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
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) (const t) integer)
+ :type '(choice (const nil) integer (other t))
:group 'bookmark)
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 t) (const nil) (const never) (const nospecial))
+ :type '(choice (const nil) (const never) (const nospecial)
+ (other t))
:group 'bookmark)
;; This variable is probably obsolete now...
(or (boundp 'baud-rate)
- ;; some random value higher than 9600
+ ;; some random value higher than 9600
(setq baud-rate 19200))
-;; XEmacs apparently call this `buffer-substring-without-properties',
-;; sigh.
-(or (fboundp 'buffer-substring-no-properties)
- (if (fboundp 'buffer-substring-without-properties)
- (fset 'buffer-substring-no-properties
- 'buffer-substring-without-properties)
- (fset 'buffer-substring-no-properties 'buffer-substring)))
\f
;;; Keymap stuff:
(defvar bookmarks-already-loaded nil)
-;; just add the hook to make sure that people don't lose bookmarks
-;; when they kill Emacs, unless they don't want to save them.
-;;;###autoload
-(add-hook 'kill-emacs-hook
- (function
- (lambda () (and (featurep 'bookmark)
- bookmark-alist
- (bookmark-time-to-save-p t)
- (bookmark-save)))))
-
;; more stuff added by db.
-(defvar bookmark-current-bookmark nil
+(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.")
(defun bookmark-get-bookmark (bookmark)
- "Return the full entry for BOOKMARK in bookmark-alist."
- (assoc bookmark bookmark-alist))
+ "Return the full entry for BOOKMARK in bookmark-alist.
+If BOOKMARK is not a string, return nil."
+ (when (stringp bookmark)
+ (apply (if bookmark-completion-ignore-case
+ #'assoc-ignore-case
+ #'assoc)
+ (list bookmark bookmark-alist))))
(defun bookmark-get-bookmark-record (bookmark)
(defun bookmark-set-name (bookmark newname)
"Set BOOKMARK's name to NEWNAME."
- (setcar (bookmark-get-bookmark bookmark) newname))
+ (setcar
+ (if (stringp bookmark) (bookmark-get-bookmark bookmark) bookmark)
+ newname))
(defun bookmark-get-annotation (bookmark)
(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."
(message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
(sit-for 4)
)
-
+
(defvar bookmark-history nil
"The history list for bookmark functions.")
"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)))))
+ `(or
+ (interactive-p)
+ (setq bookmark-history (cons ,string bookmark-history))))
(defun bookmark-make (name &optional annotation overwrite info-node)
;; 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
+ (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
))))
;; 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
;; Finally, return the completed record.
the-record))
-
-
+
+
\f
;;; File format stuff
;; risk of interfering with existing ones.
;;
;; BOOKMARK-NAME is the string the user gives the bookmark and
-;; accesses it by from then on.
+;; 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.
+;; 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.
+;; 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.
(format "Set bookmark (%s): " default)
nil
(let ((now-map (copy-keymap minibuffer-local-map)))
- (progn (define-key now-map "\C-w"
- 'bookmark-yank-word)
- (define-key now-map "\C-u"
- 'bookmark-insert-current-bookmark))
+ (define-key now-map "\C-w" 'bookmark-yank-word)
+ (define-key now-map "\C-u" 'bookmark-insert-current-bookmark)
now-map))))
(annotation nil))
(and (string-equal str "") (setq str default))
- ;; Ask for an annotation buffer for this bookmark
+ ;; Ask for an annotation buffer for this bookmark
(if bookmark-use-annotations
(bookmark-read-annotation parg str)
- (progn
- (bookmark-make str annotation parg (bookmark-info-current-node))
- (setq bookmark-current-bookmark str)
- (bookmark-bmenu-surreptitiously-rebuild-list)
- (goto-char bookmark-current-point)))))
+ (bookmark-make str annotation parg (bookmark-info-current-node))
+ (setq bookmark-current-bookmark str)
+ (bookmark-bmenu-surreptitiously-rebuild-list)
+ (goto-char bookmark-current-point))))
(defun bookmark-info-current-node ()
(if (looking-at "^#")
(bookmark-kill-line t)
(forward-line 1)))
- (let ((annotation (buffer-substring (point-min) (point-max)))
+ (let ((annotation (buffer-string))
(parg bookmark-annotation-paragraph)
(bookmark bookmark-annotation-name)
(pt bookmark-annotation-point)
;; Actually, bookmark-make-cell should probably be re-written,
;; to avoid this need. Should I handle the error if a buffer is
;; killed between "C-x r m" and a "C-c C-c" in the annotation buffer?
- (save-excursion
+ (save-excursion
(pop-to-buffer buf)
(goto-char pt)
(bookmark-make bookmark annotation parg (bookmark-info-current-node))
(setq major-mode 'bookmark-edit-annotation-mode)
(insert (funcall bookmark-read-annotation-text-func bookmark))
(let ((annotation (bookmark-get-annotation bookmark)))
- (if (and (not (eq annotation nil))
- (not (string-equal annotation "")))
+ (if (and annotation (not (string-equal annotation "")))
(insert annotation)))
(run-hooks 'text-mode-hook))
(if (looking-at "^#")
(bookmark-kill-line t)
(forward-line 1)))
- (let ((annotation (buffer-substring (point-min) (point-max)))
+ (let ((annotation (buffer-string))
(bookmark bookmark-annotation-name))
(bookmark-set-annotation bookmark annotation)
(bookmark-bmenu-surreptitiously-rebuild-list)
(goto-char bookmark-yank-point)
(buffer-substring-no-properties
(point)
- (save-excursion
+ (progn
(forward-word 1)
(setq bookmark-yank-point (point)))))))
(insert string)))
(expand-file-name bookmark-default-file)))
;; return t so the `and' will continue...
t)
-
+
(file-readable-p (expand-file-name bookmark-default-file))
- (progn
- (bookmark-load bookmark-default-file t t)
- (setq bookmarks-already-loaded t))))
+ (bookmark-load bookmark-default-file t t)
+ (setq bookmarks-already-loaded t)))
(defun bookmark-maybe-sort-alist ()
;;;###autoload
(defun bookmark-jump (bookmark)
- "Jump to bookmark BOOKMARK (a point in some file).
+ "Jump to bookmark BOOKMARK (a point in some file).
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
(bookmark-show-annotation bookmark)))))
+(defun bookmark-file-or-variation-thereof (file)
+ "Return FILE (a string) if it exists in any reasonable variation, else nil.
+Reasonable variations are FILE.gz, FILE.Z, FILE.info, FILE.info.gz, etc."
+ (cond
+ ((file-exists-p file) file)
+ ((file-exists-p (concat file ".Z")) (concat file ".Z"))
+ ((file-exists-p (concat file ".gz")) (concat file ".gz"))
+ ((file-exists-p (concat file ".z")) (concat file ".z"))
+ ((file-exists-p (concat file ".info")) (concat file ".info"))
+ ((file-exists-p (concat file ".info.gz")) (concat file ".info.gz"))
+ ((file-exists-p (concat file ".info.Z")) (concat file ".info.Z"))
+ ((file-exists-p (concat file ".info.z")) (concat file ".info.z"))
+ ((vc-backend file) file) ; maybe VC has it?
+ (t nil)))
+
+
(defun bookmark-jump-noselect (str)
;; a leetle helper for bookmark-jump :-)
;; returns (BUFFER . POINT)
(info-node (bookmark-get-info-node str))
(orig-file file)
)
- (if (or
- (file-exists-p file)
- ;; else try some common compression extensions
- ;; and Emacs better handle it right!
- ;; Sigh: I think it may *not* be handled at the moment. What
- ;; to do about this?
- (setq file
- (or
- (let ((altname (concat file ".Z")))
- (and (file-exists-p altname)
- altname))
- (let ((altname (concat file ".gz")))
- (and (file-exists-p altname)
- altname))
- (let ((altname (concat file ".z")))
- (and (file-exists-p altname)
- altname)))))
+ (if (setq file (bookmark-file-or-variation-thereof file))
(save-excursion
- (if info-node
- ;; Info nodes must be visited with care.
- (progn
- (require 'info)
- (Info-find-node file info-node))
- ;; Else no Info. Can do an ordinary find-file:
- (set-buffer (find-file-noselect file))
- (goto-char place))
-
- ;; Go searching forward first. Then, if forward-str exists and
- ;; was found in the file, we can search backward for behind-str.
- ;; Rationale is that if text was inserted between the two in the
- ;; file, it's better to be put before it so you can read it,
- ;; rather than after and remain perhaps unaware of the changes.
- (if forward-str
- (if (search-forward forward-str (point-max) t)
- (goto-char (match-beginning 0))))
- (if behind-str
- (if (search-backward behind-str (point-min) t)
- (goto-char (match-end 0))))
- ;; added by db
- (setq bookmark-current-bookmark str)
- (cons (current-buffer) (point)))
- (progn
- (ding)
- (if (y-or-n-p (concat (file-name-nondirectory orig-file)
- " nonexistent. Relocate \""
- str
- "\"? "))
- (progn
- (bookmark-relocate str)
- ;; gasp! It's a recursive function call in Emacs Lisp!
- (bookmark-jump-noselect str))
- (message
- "Bookmark not relocated; consider removing it \(%s\)." str)
- nil)))))
+ (save-window-excursion
+ (if info-node
+ ;; Info nodes must be visited with care.
+ (progn
+ (require 'info)
+ (Info-find-node file info-node))
+ ;; Else no Info. Can do an ordinary find-file:
+ (set-buffer (find-file-noselect file))
+ (goto-char place))
+
+ ;; Go searching forward first. Then, if forward-str exists and
+ ;; was found in the file, we can search backward for behind-str.
+ ;; Rationale is that if text was inserted between the two in the
+ ;; file, it's better to be put before it so you can read it,
+ ;; rather than after and remain perhaps unaware of the changes.
+ (if forward-str
+ (if (search-forward forward-str (point-max) t)
+ (goto-char (match-beginning 0))))
+ (if behind-str
+ (if (search-backward behind-str (point-min) t)
+ (goto-char (match-end 0))))
+ ;; added by db
+ (setq bookmark-current-bookmark str)
+ (cons (current-buffer) (point))))
+
+ ;; Else unable to find the marked file, so ask if user wants to
+ ;; relocate the bookmark, else remind them to consider deletion.
+ (ding)
+ (if (y-or-n-p (concat (file-name-nondirectory orig-file)
+ " nonexistent. Relocate \""
+ str
+ "\"? "))
+ (progn
+ (bookmark-relocate str)
+ ;; gasp! It's a recursive function call in Emacs Lisp!
+ (bookmark-jump-noselect str))
+ (message
+ "Bookmark not relocated; consider removing it \(%s\)." str)
+ nil))))
;;;###autoload
(read-file-name
(format "Relocate %s to: " bookmark)
(file-name-directory bmrk-filename)))))
- (bookmark-set-filename bookmark newloc)))
+ (bookmark-set-filename bookmark newloc)
+ (bookmark-bmenu-surreptitiously-rebuild-list)))
;;;###autoload
(let ((start (point)))
(prog1
(insert (bookmark-location bookmark)) ; *Return this line*
- (if window-system
- (put-text-property start
+ (if (and (display-color-p) (display-mouse-p))
+ (put-text-property start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
(interactive (bookmark-completing-read "Old bookmark name"))
(bookmark-maybe-historicize-string old)
(bookmark-maybe-load-default-file)
- (progn
- (setq bookmark-current-point (point))
- (setq bookmark-yank-point (point))
- (setq bookmark-current-buffer (current-buffer))
- (let ((newname
- (or new ; use second arg, if non-nil
- (read-from-minibuffer
- "New name: "
- nil
- (let ((now-map (copy-keymap minibuffer-local-map)))
- (define-key now-map "\C-w" 'bookmark-yank-word)
- now-map)
- nil
- 'bookmark-history))))
- (progn
- (bookmark-set-name old newname)
- (setq bookmark-current-bookmark newname)
- (bookmark-bmenu-surreptitiously-rebuild-list)
- (setq bookmark-alist-modification-count
- (1+ bookmark-alist-modification-count))
- (if (bookmark-time-to-save-p)
- (bookmark-save))))))
+
+ (setq bookmark-current-point (point))
+ (setq bookmark-yank-point (point))
+ (setq bookmark-current-buffer (current-buffer))
+ (let ((newname
+ (or new ; use second arg, if non-nil
+ (read-from-minibuffer
+ "New name: "
+ nil
+ (let ((now-map (copy-keymap minibuffer-local-map)))
+ (define-key now-map "\C-w" 'bookmark-yank-word)
+ now-map)
+ nil
+ 'bookmark-history))))
+ (bookmark-set-name old newname)
+ (setq bookmark-current-bookmark newname)
+ (bookmark-bmenu-surreptitiously-rebuild-list)
+ (setq bookmark-alist-modification-count
+ (1+ bookmark-alist-modification-count))
+ (if (bookmark-time-to-save-p)
+ (bookmark-save))))
;;;###autoload
(defun bookmark-insert (bookmark)
- "Insert the text of the file pointed to by bookmark BOOKMARK.
+ "Insert the text of the file pointed to by bookmark BOOKMARK.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
(str-to-insert
(save-excursion
(set-buffer (car (bookmark-jump-noselect bookmark)))
- (buffer-substring (point-min) (point-max)))))
+ (buffer-string))))
(insert str-to-insert)
(push-mark)
(goto-char orig-point)))
;;;###autoload
(defun bookmark-delete (bookmark &optional batch)
- "Delete BOOKMARK from the bookmark list.
+ "Delete BOOKMARK from the bookmark list.
Removes only the first instance of a bookmark with that name. If
there are one or more other bookmarks with the same name, they will
not be deleted. Defaults to the \"current\" bookmark \(that is, the
;; bookmark-alist-modification-count. Returns t if they should be
;; saved, nil otherwise. if last-time is non-nil, then this is
;; being called when emacs is killed.
- (cond (last-time
+ (cond (last-time
(and (> bookmark-alist-modification-count 0)
bookmark-save-flag))
((numberp bookmark-save-flag)
;;;###autoload
-(defun bookmark-save (&optional parg file)
+(defun bookmark-save (&optional parg file)
"Save currently defined bookmarks.
Saves by default in the file defined by the variable
`bookmark-default-file'. With a prefix arg, save it in file FILE
))))
+(defun bookmark-import-new-list (new-list)
+ ;; Walk over the new list, adding each individual bookmark
+ ;; carefully. "Carefully" means checking against the existing
+ ;; bookmark-alist and renaming the new bookmarks with <N> extensions
+ ;; as necessary.
+ (let ((lst new-list)
+ (names (bookmark-all-names)))
+ (while lst
+ (let* ((full-record (car lst)))
+ (bookmark-maybe-rename full-record names)
+ (setq bookmark-alist (nconc bookmark-alist (list full-record)))
+ (setq names (cons (bookmark-name-from-full-record full-record) names))
+ (setq lst (cdr lst))))))
+
+
+(defun bookmark-maybe-rename (full-record names)
+ ;; just a helper for bookmark-import-new-list; it is only for
+ ;; readability that this is not inlined.
+ ;;
+ ;; Once this has found a free name, it sets full-record to that
+ ;; name.
+ (let ((found-name (bookmark-name-from-full-record full-record)))
+ (if (member found-name names)
+ ;; We've got a conflict, so generate a new name
+ (let ((count 2)
+ (new-name found-name))
+ (while (member new-name names)
+ (setq new-name (concat found-name (format "<%d>" count)))
+ (setq count (1+ count)))
+ (bookmark-set-name full-record new-name)))))
+
+
;;;###autoload
-(defun bookmark-load (file &optional revert no-msg)
+(defun bookmark-load (file &optional overwrite no-msg)
"Load bookmarks from FILE (which must be in bookmark format).
Appends loaded bookmarks to the front of the list of bookmarks. If
-optional second argument REVERT is non-nil, existing bookmarks are
+optional second argument OVERWRITE is non-nil, existing bookmarks are
destroyed. Optional third arg NO-MSG means don't display any messages
while loading.
in files that were created with the bookmark functions in the first
place. Your own personal bookmark file, `~/.emacs.bmk', is
maintained automatically by Emacs; you shouldn't need to load it
-explicitly."
+explicitly.
+
+If you load a file containing bookmarks with the same names as
+bookmarks already present in your Emacs, the new bookmarks will get
+unique numeric suffixes \"<2>\", \"<3>\", ... following the same
+method buffers use to resolve name collisions."
(interactive
(list (read-file-name
(format "Load bookmarks from: (%s) "
- bookmark-default-file)
+ bookmark-default-file)
;;Default might not be used often,
;;but there's no better default, and
;;I guess it's better than none at all.
(let ((blist (bookmark-alist-from-buffer)))
(if (listp blist)
(progn
- (if (not revert)
- (setq bookmark-alist-modification-count
- (1+ bookmark-alist-modification-count))
- (setq bookmark-alist-modification-count 0))
- (setq bookmark-alist
- (append blist (if (not revert) bookmark-alist)))
- (bookmark-bmenu-surreptitiously-rebuild-list))
+ (if overwrite
+ (progn
+ (setq bookmark-alist blist)
+ (setq bookmark-alist-modification-count 0))
+ ;; else
+ (bookmark-import-new-list blist)
+ (setq bookmark-alist-modification-count
+ (1+ bookmark-alist-modification-count)))
+ (if (string-equal
+ (expand-file-name bookmark-default-file)
+ file)
+ (setq bookmarks-already-loaded t))
+ (bookmark-bmenu-surreptitiously-rebuild-list))
(error "Invalid bookmark list in %s" file)))
(kill-buffer (current-buffer)))
(if (and (null no-msg) (>= baud-rate 9600))
nil
(setq bookmark-bmenu-mode-map (make-keymap))
(suppress-keymap bookmark-bmenu-mode-map t)
- (define-key bookmark-bmenu-mode-map "q" 'bookmark-bmenu-quit)
+ (define-key bookmark-bmenu-mode-map "q" 'quit-window)
(define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
(define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
(define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
(define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
+ (define-key bookmark-bmenu-mode-map "\C-m" 'bookmark-bmenu-this-window)
(define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
(define-key bookmark-bmenu-mode-map "\C-o"
'bookmark-bmenu-switch-other-window)
(define-key bookmark-bmenu-mode-map "?" 'describe-mode)
(define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark)
(define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark)
- (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
+ (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
(define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
(define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
(define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
(define-key bookmark-bmenu-mode-map [mouse-2]
'bookmark-bmenu-other-window-with-mouse))
-
+
;; Bookmark Buffer Menu mode is suitable only for specially formatted
;; data.
;; todo: need to display whether or not bookmark exists as a buffer in
-;; flag column.
+;; flag column.
;; Format:
;; FLAGS BOOKMARK [ LOCATION ]
Don't affect the buffer ring order."
(if (get-buffer "*Bookmark List*")
(save-excursion
- (save-window-excursion
+ (save-window-excursion
(bookmark-bmenu-list)))))
;; in the list of bookmarks.
(let ((annotation (bookmark-get-annotation
(bookmark-name-from-full-record full-record))))
- (if (and (not (eq annotation nil))
- (not (string-equal annotation "")))
+ (if (and annotation (not (string-equal annotation "")))
(insert " *")
(insert " "))
(let ((start (point)))
(insert (bookmark-name-from-full-record full-record))
- (if window-system
- (put-text-property start
+ (if (and (display-color-p) (display-mouse-p))
+ (put-text-property start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
\\[bookmark-bmenu-other-window] -- select this bookmark in another window,
so the bookmark menu bookmark remains visible in its window.
\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
-\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
+\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
-\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
+\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
With a prefix arg, prompts for a file to save in.
(let ((start (save-excursion (end-of-line) (point))))
(move-to-column bookmark-bmenu-file-column t)
;; Strip off `mouse-face' from the white spaces region.
- (if window-system
+ (if (and (display-color-p) (display-mouse-p))
(remove-text-properties start (point)
'(mouse-face))))
(delete-region (point) (progn (end-of-line) (point)))
(bookmark-kill-line)
(let ((start (point)))
(insert (car bookmark-bmenu-hidden-bookmarks))
- (if window-system
- (put-text-property start
+ (if (and (display-color-p) (display-mouse-p))
+ (put-text-property start
(save-excursion (re-search-backward
"[^ \t]")
(1+ (point)))
(forward-line 1))))))))
-;; if you look at this next function from far away, it resembles a
-;; gun. But only with this comment above...
(defun bookmark-bmenu-check-position ()
- ;; Returns t if on a line with a bookmark.
- ;; Otherwise, repositions and returns t.
- ;; written by David Hughes <djh@harston.cv.com>
- ;; Mucho thanks, David! -karl
+ ;; Returns non-nil if on a line with a bookmark.
+ ;; (The actual value returned is bookmark-alist).
+ ;; Else reposition and try again, else return nil.
(cond ((< (count-lines (point-min) (point)) 2)
(goto-char (point-min))
(forward-line 2)
- t)
+ bookmark-alist)
((and (bolp) (eobp))
(beginning-of-line 0)
- t)
+ bookmark-alist)
(t
- t)))
+ bookmark-alist)))
(defun bookmark-bmenu-bookmark ()
(beginning-of-line)
(forward-char bookmark-bmenu-bookmark-column)
(prog1
- (buffer-substring-no-properties (point)
- (progn
+ (buffer-substring-no-properties (point)
+ (progn
(end-of-line)
(point)))
;; well, this is certainly crystal-clear:
"Display the annotation for bookmark named BOOKMARK in a buffer,
if an annotation exists."
(let ((annotation (bookmark-get-annotation bookmark)))
- (if (and (not (eq annotation nil))
- (not (string-equal annotation "")))
- (progn
- (save-excursion
- (let ((old-buf (current-buffer)))
- (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
- (delete-region (point-min) (point-max))
- ; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
- (insert annotation)
- (goto-char (point-min))
- (pop-to-buffer old-buf)))))))
+ (if (and annotation (not (string-equal annotation "")))
+ (save-excursion
+ (let ((old-buf (current-buffer)))
+ (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
+ (delete-region (point-min) (point-max))
+ ;; (insert (concat "Annotation for bookmark '" bookmark "':\n\n"))
+ (insert annotation)
+ (goto-char (point-min))
+ (pop-to-buffer old-buf))))))
(defun bookmark-show-all-annotations ()
(let* ((name (bookmark-name-from-full-record full-record))
(ann (bookmark-get-annotation name)))
(insert (concat name ":\n"))
- (if (and (not (eq ann nil)) (not (string-equal ann "")))
+ (if (and ann (not (string-equal ann "")))
;; insert the annotation, indented by 4 spaces.
(progn
(save-excursion (insert ann))
(let ((buffer-read-only nil))
(delete-char 1)
(insert ?>)
- (forward-line 1))))
+ (forward-line 1)
+ (bookmark-bmenu-check-position))))
(defun bookmark-bmenu-select ()
(interactive)
(if (bookmark-bmenu-check-position)
(let ((bmrk (bookmark-bmenu-bookmark))
- (menu (current-buffer))
+ (menu (current-buffer))
(others ())
tem)
(goto-char (point-min))
(let ((buffer-read-only nil))
(delete-char -1)
(insert ?\ ))
- (or (string-equal tem bmrk)
- (member tem others)
+ (or (string-equal tem bmrk)
+ (member tem others)
(setq others (cons tem others))))
(setq others (nreverse others)
tem (/ (1- (frame-height)) (1+ (length others))))
"Make the other window select this line's bookmark.
The current window remains selected."
(interactive)
- (let ((bookmark (bookmark-bmenu-bookmark)))
+ (let ((bookmark (bookmark-bmenu-bookmark))
+ (pop-up-windows t)
+ same-window-buffer-names
+ same-window-regexps)
(if (bookmark-bmenu-check-position)
(let* ((pair (bookmark-jump-noselect bookmark))
(buff (car pair))
(bookmark-edit-annotation bookmark))))
-(defun bookmark-bmenu-quit ()
- "Quit the bookmark menu."
- (interactive)
- (let ((buffer (current-buffer)))
- (switch-to-buffer (other-buffer))
- (bury-buffer buffer)))
-
-
(defun bookmark-bmenu-unmark (&optional backup)
"Cancel all requested operations on bookmark on this line and move down.
Optional BACKUP means move up."
;; flag indicating whether this bookmark is being visited?
;; well, we don't have this now, so maybe later.
(insert " "))
- (forward-line (if backup -1 1)))))
+ (forward-line (if backup -1 1))
+ (bookmark-bmenu-check-position))))
(defun bookmark-bmenu-backup-unmark ()
(if (bookmark-bmenu-check-position)
(progn
(bookmark-bmenu-unmark)
- (forward-line -1))))
+ (forward-line -1)
+ (bookmark-bmenu-check-position))))
(defun bookmark-bmenu-delete ()
(let ((buffer-read-only nil))
(delete-char 1)
(insert ?D)
- (forward-line 1))))
+ (forward-line 1)
+ (bookmark-bmenu-check-position))))
(defun bookmark-bmenu-delete-backwards ()
(bookmark-bmenu-delete)
(forward-line -2)
(if (bookmark-bmenu-check-position)
- (forward-line 1)))
+ (forward-line 1))
+ (bookmark-bmenu-check-position))
(defun bookmark-bmenu-execute-deletions ()
(cons (concat "-*- " name " -*-") pane-list)))
-(defun bookmark-build-xemacs-menu (name entries function)
- "Build a menu named NAME from the strings in ENTRIES.
-That is, ENTRIES is a list of strings that appear as the choices
-in the menu.
-The visible entries are truncated to `bookmark-menu-length', but the
-strings returned are not."
- (let* (lst
- (pane-list
- (progn
- (while entries
- (let ((str (car entries)))
- (setq lst (cons
- (vector
- (if (> (length str) bookmark-menu-length)
- (substring str 0 bookmark-menu-length)
- str)
- (list function str)
- t)
- lst))
- (setq entries (cdr entries))))
- (nreverse lst))))
-
- ;; Return the menu:
- (append (if popup-menu-titles (list (concat "-*- " name " -*-")))
- pane-list)))
-
-
(defun bookmark-menu-popup-paned-menu (event name entries)
"Pop up multi-paned menu at EVENT, return string chosen from ENTRIES.
That is, ENTRIES is a list of strings which appear as the choices
;;;###autoload
(defun bookmark-menu-insert (event)
- "Insert the text of the file pointed to by bookmark BOOKMARK.
+ "Insert the text of the file pointed to by bookmark BOOKMARK.
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
;;;###autoload
(defun bookmark-menu-jump (event)
- "Jump to bookmark BOOKMARK (a point in some file).
+ "Jump to bookmark BOOKMARK (a point in some file).
You may have a problem using this function if the value of variable
`bookmark-alist' is nil. If that happens, you need to load in some
bookmarks. See help on function `bookmark-load' for more about
;;;###autoload
(defun bookmark-menu-locate (event)
- "Insert the name of the file associated with BOOKMARK.
+ "Insert the name of the file associated with BOOKMARK.
\(This is not the same as the contents of that file\).
Warning: this function only takes an EVENT as argument. Use the
;;;###autoload
(defun bookmark-menu-rename (event)
- "Change the name of OLD-BOOKMARK to NEWNAME.
+ "Change the name of OLD-BOOKMARK to NEWNAME.
If called from keyboard, prompts for OLD-BOOKMARK and NEWNAME.
If called from menubar, OLD-BOOKMARK is selected from a menu, and
-prompts for NEWNAME.
+prompts for NEWNAME.
If called from Lisp, prompts for NEWNAME if only OLD-BOOKMARK was
passed as an argument. If called with two strings, then no prompting
is done. You must pass at least OLD-BOOKMARK when calling from Lisp.
;;;###autoload
(defun bookmark-menu-delete (event)
- "Delete the bookmark named NAME from the bookmark list.
+ "Delete the bookmark named NAME from the bookmark list.
Removes only the first instance of a bookmark with that name. If
there are one or more other bookmarks with the same name, they will
not be deleted. Defaults to the \"current\" bookmark \(that is, the
;; make bookmarks appear toward the right side of the menu.
(if (boundp 'menu-bar-final-items)
- (if menu-bar-final-items
+ (if menu-bar-final-items
(setq menu-bar-final-items
(cons 'bookmark menu-bar-final-items)))
(setq menu-bar-final-items '(bookmark)))
'("Set Bookmark" . bookmark-set))
;;;###autoload
-(define-key menu-bar-bookmark-map [jump]
+(define-key menu-bar-bookmark-map [jump]
'("Jump to Bookmark" . bookmark-menu-jump))
;;;; end bookmark menu stuff ;;;;
(defvar bookmark-load-hook nil
"Hook to run at the end of loading bookmark.")
+;;; Exit Hook, called from kill-emacs-hook
+(defvar bookmark-exit-hook nil
+ "Hook to run when emacs exits")
+
+(defun bookmark-exit-hook-internal ()
+ "Save bookmark state, if necessary, at Emacs exit time.
+This also runs `bookmark-exit-hooks'."
+ (and
+ (progn (run-hooks 'bookmark-exit-hooks) t)
+ bookmark-alist
+ (bookmark-time-to-save-p t)
+ (bookmark-save)))
+
+(add-hook 'kill-emacs-hook 'bookmark-exit-hook-internal)
+
+
(run-hooks 'bookmark-load-hook)
(provide 'bookmark)
-
+
;;; bookmark.el ends here