;; 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.
(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
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)
;; 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:
-;; some people have C-x r set to rmail or whatever. We don't want to
-;; assume that C-x r is a prefix map just because it's distributed
-;; that way...
-;; These are the distribution keybindings suggested by RMS, everything
-;; else will be done with M-x or the menubar:
-;;;###autoload
-(if (symbolp (key-binding "\C-xr"))
- nil
- (progn (define-key ctl-x-map "rb" 'bookmark-jump)
- (define-key ctl-x-map "rm" 'bookmark-set)
- (define-key ctl-x-map "rl" 'bookmark-bmenu-list)))
-;; define the map, so it can be bound by those who desire to do so:
+;; 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-map "rb" 'bookmark-jump)
+;;;###autoload (define-key ctl-x-map "rm" 'bookmark-set)
+;;;###autoload (define-key ctl-x-map "rl" 'bookmark-bmenu-list)
;;;###autoload
(defvar bookmark-map nil
(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)
))))
;; 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
(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
(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)
(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)))
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 ()
)
(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?
+ ;; Else try some common compression extensions, which Emacs
+ ;; usually handles right. I hope.
(setq file
(or
(let ((altname (concat file ".Z")))
altname))
(let ((altname (concat file ".z")))
(and (file-exists-p altname)
- altname)))))
+ altname))
+ ;; Check VC incarnations, preparatory to checkout
+ (if (vc-backend file) file nil))))
(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
(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
(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)))
))))
+(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) "
(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)))
+ (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)))
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)
;; 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)))
(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 ()
"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 ()
"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