mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

(bookmark-load): Use `bookmark-import-new-list' to

Browse source 
load the new list carefully, renaming bookmarks as necessary.
In docstring, mention new renaming behavior.
Optional arg OVERWRITE replaces inaccurately-named REVERT.
If file loaded was bookmark-default-file, then set
bookmarks-already-loaded to t.
(bookmark-import-new-list): New func.
(bookmark-maybe-rename): New func, helper to above.
(bookmark-set-name): Accept bookmark as either string (behaves
same as before) or list (treat it as a bookmark record).

(bookmark-set, bookmark-maybe-load-default-file)
(bookmark-jump-noselect, bookmark-rename)
(bookmark-show-annotation): Discard pointless `progn's.

(bookmark-bmenu-mark, bookmark-bmenu-unmark)
(bookmark-bmenu-backup-unmark, bookmark-bmenu-delete-backwards):
Renormalize position after all else is done.

(bookmark-edit-annotation-mode, bookmark-bmenu-list)
(bookmark-show-annotation, bookmark-show-all-annotations):
Use `x' instead of `(not (eq x nil))'.

(bookmark-yank-word): Inner save-excursion changed to progn.
(bookmark-send-annotation, bookmark-send-edited-annotation)
(bookmark-insert): Use buffer-string instead of buffer-substring.
(bookmark-make-cell): Make sure annotation and info-node strings
contain no text properties.
(bookmark-relocate): Remember to rebuild bmenu buffer after a
bookmark has been relocated.
(bookmark-bmenu-check-position): Return a meaningful value --
callers have apparently been assuming this anyway.
(bookmark-build-xemacs-menu): Unused function deleted.
(bookmark-version): Removed this variable; the Emacs version suffices.
This commit is contained in:
Richard M. Stallman 1997-08-22 19:14:10 +00:00
parent ddee363a5b
commit 91169ba7cb
1 changed files with 137 additions and 125 deletions
Download patch file Download diff file Expand all files Collapse all files

262
lisp/bookmark.el
View file

@ -5,7 +5,6 @@
;; 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.
@ -82,11 +81,6 @@
(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
@ -379,7 +373,9 @@ That is, all information but the name."
(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)
@ -571,6 +567,11 @@ INFO-NODE, so record this fact in the bookmark's entry."
))))
;; 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
@ -782,21 +783,18 @@ the list of bookmarks.\)"
(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 ()
@ -836,7 +834,7 @@ the bookmark (and file, and point) specified in buffer local variables."
(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)
@ -926,8 +924,7 @@ When you have finished composing, type \\[bookmark-send-annotation].
(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))
@ -942,7 +939,7 @@ When you have finished composing, type \\[bookmark-send-annotation].
(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)
@ -1013,7 +1010,7 @@ In Info, return the current node."
(goto-char bookmark-yank-point)
(buffer-substring-no-properties
(point)
(save-excursion
(progn
(forward-word 1)
(setq bookmark-yank-point (point)))))))
(insert string)))
@ -1047,9 +1044,8 @@ For example, if this is a Info buffer, return the Info file's name."
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 ()
@ -1139,19 +1135,20 @@ of the old one in the permanent bookmark record."
;; 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)))))
;; 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
@ -1168,7 +1165,8 @@ after a bookmark was set in it."
(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
@ -1213,28 +1211,27 @@ name."
(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
@ -1251,7 +1248,7 @@ this."
(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)))
@ -1375,11 +1372,43 @@ for a file, defaulting to the file defined by variable
))))
(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.
@ -1388,7 +1417,12 @@ will corrupt Emacs's bookmark list. Generally, you should only load
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) "
@ -1410,12 +1444,18 @@ explicitly."
(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)))
@ -1519,8 +1559,7 @@ deletion, or > if it is flagged for displaying."
;; 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)))
@ -1663,22 +1702,19 @@ Optional argument SHOW means show them unconditionally."
(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 ()
@ -1710,17 +1746,15 @@ Optional argument SHOW means show them unconditionally."
"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 ()
@ -1733,7 +1767,7 @@ if an annotation exists."
(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))
@ -1755,7 +1789,8 @@ if an annotation exists."
(let ((buffer-read-only nil))
(delete-char 1)
(insert ?>)
(forward-line 1))))
(forward-line 1)
(bookmark-bmenu-check-position))))
(defun bookmark-bmenu-select ()
@ -1928,7 +1963,8 @@ 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 ()
@ -1938,7 +1974,8 @@ Optional BACKUP means move up."
(if (bookmark-bmenu-check-position)
(progn
(bookmark-bmenu-unmark)
(forward-line -1))))
(forward-line -1)
(bookmark-bmenu-check-position))))
(defun bookmark-bmenu-delete ()
@ -1950,7 +1987,8 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(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 ()
@ -1960,7 +1998,8 @@ To carry out the deletions that you've marked, use \\<bookmark-bmenu-mode-map>\\
(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 ()
@ -2063,33 +2102,6 @@ strings returned are not."
(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