From 91169ba7cb60732b2cc4750103bbca1af397dd29 Mon Sep 17 00:00:00 2001 From: "Richard M. Stallman" Date: Fri, 22 Aug 1997 19:14:10 +0000 Subject: [PATCH] (bookmark-load): Use `bookmark-import-new-list' to 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. --- lisp/bookmark.el | 262 +++++++++++++++++++++++++---------------------- 1 file changed, 137 insertions(+), 125 deletions(-) diff --git a/lisp/bookmark.el b/lisp/bookmark.el index b41d9fc1158..511c237b028 100644 --- a/lisp/bookmark.el +++ b/lisp/bookmark.el @@ -5,7 +5,6 @@ ;; Author: Karl Fogel ;; Maintainer: Karl Fogel ;; 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 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 - ;; 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 \\\\ (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-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 -- 2.39.2