-;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later.
+;;; 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>
;; 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
-;;;; Code:
+;;; Code:
(require 'pp)
(defcustom bookmark-automatically-show-annotations t
- "*Nil means don't show annotations when jumping to a bookmark."
+ "*nil means don't show annotations when jumping to a bookmark."
:type 'boolean
:group 'bookmark)
(defcustom bookmark-menu-length 70
"*Maximum length of a bookmark name displayed on a popup menu."
:type 'integer
- :group 'boolean)
+ :group 'bookmark)
;;; No user-serviceable parts beyond this point.
(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)
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)))
- ))))
+ `((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:
(ann (nth 4 record)))
(list
name
- (` ((filename . (, filename))
- (front-context-string . (, (or front-str "")))
- (rear-context-string . (, (or rear-str "")))
- (position . (, position))
- (annotation . (, ann)))))))
+ `((filename . ,filename)
+ (front-context-string . ,(or front-str ""))
+ (rear-context-string . ,(or rear-str ""))
+ (position . ,position)
+ (annotation . ,ann)))))
old-list))
(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)))
+ "Return FILE (a string) if it exists, or return a reasonable
+variation of FILE if that exists. Reasonable variations are checked
+by appending suffixes defined in `Info-suffix-list'. If cannot find FILE
+nor a reasonable variation thereof, then still return FILE if it can
+be retrieved from a VC backend, else return nil."
+ (if (file-exists-p file)
+ file
+ (or
+ (progn (require 'info) ; ensure Info-suffix-list is bound
+ (catch 'found
+ (mapc (lambda (elt)
+ (let ((suffixed-file (concat file (car elt))))
+ (if (file-exists-p suffixed-file)
+ (throw 'found suffixed-file))))
+ Info-suffix-list)
+ nil))
+ ;; Last possibility: try VC
+ (if (vc-backend file) file))))
(defun bookmark-jump-noselect (str)
(prog1
(insert (bookmark-location bookmark)) ; *Return this line*
(if (and (display-color-p) (display-mouse-p))
- (put-text-property start
- (save-excursion (re-search-backward
- "[^ \t]")
- (1+ (point)))
- 'mouse-face 'highlight)))))
+ (add-text-properties start
+ (save-excursion (re-search-backward
+ "[^ \t]")
+ (1+ (point)))
+ '(mouse-face highlight
+ help-echo "mouse-2: go to this bookmark"))))))
;;;###autoload
(defalias 'bookmark-locate 'bookmark-insert-location)
(set-buffer (let ((enable-local-variables nil))
(find-file-noselect file)))
(goto-char (point-min))
- (delete-region (point-min) (point-max))
- (bookmark-insert-file-format-version-stamp)
- (pp bookmark-alist (current-buffer))
- (let ((version-control
- (cond
- ((null bookmark-version-control) nil)
- ((eq 'never bookmark-version-control) 'never)
- ((eq 'nospecial bookmark-version-control) version-control)
- (t
- t))))
- (write-file file)
- (kill-buffer (current-buffer))
- (if (>= baud-rate 9600)
- (message "Saving bookmarks to file %s...done" file))
- ))))
+ (let ((print-length nil)
+ (print-level nil))
+ (delete-region (point-min) (point-max))
+ (bookmark-insert-file-format-version-stamp)
+ (pp bookmark-alist (current-buffer))
+ (let ((version-control
+ (cond
+ ((null bookmark-version-control) nil)
+ ((eq 'never bookmark-version-control) 'never)
+ ((eq 'nospecial bookmark-version-control) version-control)
+ (t
+ t))))
+ (write-file file)
+ (kill-buffer (current-buffer))
+ (if (>= baud-rate 9600)
+ (message "Saving bookmarks to file %s...done" file)))))))
(defun bookmark-import-new-list (new-list)
(let ((start (point)))
(insert (bookmark-name-from-full-record full-record))
(if (and (display-color-p) (display-mouse-p))
- (put-text-property start
- (save-excursion (re-search-backward
- "[^ \t]")
- (1+ (point)))
- 'mouse-face 'highlight))
+ (add-text-properties start
+ (save-excursion (re-search-backward
+ "[^ \t]")
+ (1+ (point)))
+ '(mouse-face highlight
+ help-echo "mouse-2: go to this bookmark")))
(insert "\n")
)))
bookmark-alist))
;; Strip off `mouse-face' from the white spaces region.
(if (and (display-color-p) (display-mouse-p))
(remove-text-properties start (point)
- '(mouse-face))))
+ '(mouse-face nil help-echo nil))))
(delete-region (point) (progn (end-of-line) (point)))
(insert " ")
;; Pass the NO-HISTORY arg:
(let ((start (point)))
(insert (car bookmark-bmenu-hidden-bookmarks))
(if (and (display-color-p) (display-mouse-p))
- (put-text-property start
- (save-excursion (re-search-backward
- "[^ \t]")
- (1+ (point)))
- 'mouse-face 'highlight)))
+ (add-text-properties start
+ (save-excursion (re-search-backward
+ "[^ \t]")
+ (1+ (point)))
+ '(mouse-face highlight
+ help-echo
+ "mouse-2: go to this bookmark"))))
(setq bookmark-bmenu-hidden-bookmarks
(cdr bookmark-bmenu-hidden-bookmarks))
(forward-line 1))))))))