;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
+;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
-;; the Free Software Foundation; either version 2, or (at your option)
+;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;;; No user-serviceable parts beyond this point.
-;; Is it XEmacs?
-(defconst bookmark-xemacsp
- (string-match "\\(Lucid\\|Xemacs\\)" emacs-version))
-
-
;; Added for lucid emacs compatibility, db
(or (fboundp 'defalias) (fset 'defalias 'fset))
(message "%S" (assq 'info-node (bookmark-get-bookmark-record bookmark)))
(sit-for 4))
+(defun bookmark-get-handler (bookmark)
+ (cdr (assq 'handler (bookmark-get-bookmark-record bookmark))))
(defvar bookmark-history nil
"The history list for bookmark functions.")
(interactive-p)
(setq bookmark-history (cons ,string bookmark-history))))
+(defvar bookmark-make-cell-function 'bookmark-make-cell-for-text-file
+ "A function that should be called to create the bookmark
+record. Modes may set this variable buffer-locally to enable
+bookmarking of non-text files like images or pdf documents.
+
+The function will be called with two arguments: ANNOTATION and
+INFO-NODE. See `bookmark-make-cell-for-text-file' for a
+description.
+
+The returned record may contain a special cons (handler . SOME-FUNCTION)
+which sets the handler function that should be used to open this
+bookmark instead of `bookmark-jump-noselect'. The handler should
+return an alist like the one that function returns, and (of course)
+should likewise not select the buffer.")
(defun bookmark-make (name &optional annotation overwrite info-node)
"Make a bookmark named NAME.
INFO-NODE, so record this fact in the bookmark's entry."
(bookmark-maybe-load-default-file)
(let ((stripped-name (copy-sequence name)))
- (or bookmark-xemacsp
+ (or (featurep 'xemacs)
;; XEmacs's `set-text-properties' doesn't work on
;; free-standing strings, apparently.
(set-text-properties 0 (length stripped-name) nil stripped-name))
;; already existing bookmark under that name and
;; no prefix arg means just overwrite old bookmark
(setcdr (bookmark-get-bookmark stripped-name)
- (list (bookmark-make-cell annotation info-node)))
+ (list (funcall bookmark-make-cell-function 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
(setq bookmark-alist
(cons
(list stripped-name
- (bookmark-make-cell annotation info-node))
+ (funcall bookmark-make-cell-function annotation info-node))
bookmark-alist)))
;; Added by db
(bookmark-save))))
-(defun bookmark-make-cell (annotation &optional info-node)
+(defun bookmark-make-cell-for-text-file (annotation &optional info-node)
"Return the record part of a new bookmark, given ANNOTATION.
Must be at the correct position in the buffer in which the bookmark is
being set. This might change someday.
(defun bookmark-info-current-node ()
- "If in Info-mode, return current node name (a string), else nil."
+ "If in `Info-mode', return current node name (a string), else nil."
(if (eq major-mode 'Info-mode)
Info-current-node))
When you have finished composing, type \\[bookmark-send-annotation] to send
the annotation.
-\\{bookmark-read-annotation-mode-map}
-"
+\\{bookmark-read-annotation-mode-map}"
(interactive)
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-paragraph)
"Mode for editing the annotation of bookmark BOOKMARK.
When you have finished composing, type \\[bookmark-send-annotation].
-\\{bookmark-edit-annotation-mode-map}
-"
+\\{bookmark-edit-annotation-mode-map}"
(interactive)
(kill-all-local-variables)
(make-local-variable 'bookmark-annotation-name)
In Info, return the current node."
(cond
;; Are we in Info?
- ((string-equal mode-name "Info") Info-current-node)
+ ((derived-mode-p 'Info-mode) Info-current-node)
;; Or are we a file?
(buffer-file-name (file-name-nondirectory buffer-file-name))
;; Or are we a directory?
(unless bookmark
(error "No bookmark specified"))
(bookmark-maybe-historicize-string bookmark)
- (let ((cell (bookmark-jump-noselect bookmark)))
- (and cell
- (switch-to-buffer (car cell))
- (goto-char (cdr cell))
+ (let ((alist (bookmark-jump-internal bookmark)))
+ (and alist
+ (switch-to-buffer (cadr (assq 'buffer alist)))
+ (goto-char (cadr (assq 'position alist)))
(progn (run-hooks 'bookmark-after-jump-hook) t)
(if bookmark-automatically-show-annotations
;; if there is an annotation for this bookmark,
(list bkm) bkm)))
(when bookmark
(bookmark-maybe-historicize-string bookmark)
- (let ((cell (bookmark-jump-noselect bookmark)))
- (and cell
- (switch-to-buffer-other-window (car cell))
- (goto-char (cdr cell))
+ (let ((alist (bookmark-jump-internal bookmark)))
+ (and alist
+ (switch-to-buffer-other-window (cadr (assq 'buffer alist)))
+ (goto-char (cadr (assq 'position alist)))
(if bookmark-automatically-show-annotations
;; if there is an annotation for this bookmark,
;; show it in a buffer.
;; Last possibility: try VC
(if (vc-backend file) file))))
+(defun bookmark-jump-internal (bookmark)
+ "Call BOOKMARK's handler or `bookmark-jump-noselect' if it has none."
+ (funcall (or (bookmark-get-handler bookmark)
+ 'bookmark-jump-noselect)
+ bookmark))
(defun bookmark-jump-noselect (str)
- ;; a leetle helper for bookmark-jump :-)
- ;; returns (BUFFER . POINT)
+ ;; Helper for bookmark-jump. STR is a bookmark name, of the sort
+ ;; accepted by `bookmark-get-bookmark'.
+ ;;
+ ;; Return an alist '((buffer BUFFER) (position POSITION) ...)
+ ;; indicating the bookmarked point within the specied buffer. Any
+ ;; elements not documented here should be ignored.
(bookmark-maybe-load-default-file)
(let* ((file (expand-file-name (bookmark-get-filename str)))
(forward-str (bookmark-get-front-context-string str))
(goto-char (match-end 0))))
;; added by db
(setq bookmark-current-bookmark str)
- (cons (current-buffer) (point))))
+ `((buffer ,(current-buffer)) (position ,(point)))))
;; Else unable to find the marked file, so ask if user wants to
;; relocate the bookmark, else remind them to consider deletion.
(bookmark-maybe-historicize-string bookmark)
(bookmark-maybe-load-default-file)
(let ((orig-point (point))
- (str-to-insert
- (save-excursion
- (set-buffer (car (bookmark-jump-noselect bookmark)))
- (buffer-string))))
+ (str-to-insert
+ (save-excursion
+ (set-buffer (cadr (assq 'buffer (bookmark-jump-internal bookmark))))
+ (buffer-string))))
(insert str-to-insert)
(push-mark)
(goto-char orig-point)))
(insert "% Bookmark\n- --------\n")
(add-text-properties (point-min) (point)
'(font-lock-face bookmark-menu-heading))
- (mapcar
+ (mapc
(lambda (full-record)
;; if a bookmark has an annotation, prepend a "*"
;; in the list of bookmarks.
(let ((old-buf (current-buffer)))
(pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
(delete-region (point-min) (point-max))
- (mapcar
+ (mapc
(lambda (full-record)
(let* ((name (bookmark-name-from-full-record full-record))
(ann (bookmark-get-annotation name)))
(pop-up-windows t))
(delete-other-windows)
(switch-to-buffer (other-buffer))
- (let* ((pair (bookmark-jump-noselect bmrk))
- (buff (car pair))
- (pos (cdr pair)))
+ (let* ((alist (bookmark-jump-internal bmrk))
+ (buff (cadr (assq 'buffer alist)))
+ (pos (cadr (assq 'position alist))))
(pop-to-buffer buff)
(goto-char pos))
(bury-buffer menu))))
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark)))
(if (bookmark-bmenu-check-position)
- (let* ((pair (bookmark-jump-noselect bookmark))
- (buff (car pair))
- (pos (cdr pair)))
+ (let* ((alist (bookmark-jump-internal bookmark))
+ (buff (cadr (assq 'buffer alist)))
+ (pos (cadr (assq 'position alist))))
(switch-to-buffer-other-window buff)
(goto-char pos)
(set-window-point (get-buffer-window buff) pos)
same-window-buffer-names
same-window-regexps)
(if (bookmark-bmenu-check-position)
- (let* ((pair (bookmark-jump-noselect bookmark))
- (buff (car pair))
- (pos (cdr pair)))
+ (let* ((alist (bookmark-jump-internal bookmark))
+ (buff (cadr (assq 'buffer alist)))
+ (pos (cadr (assq 'position alist))))
(display-buffer buff)
(let ((o-buffer (current-buffer)))
;; save-excursion won't do
(provide 'bookmark)
-;;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
+;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
;;; bookmark.el ends here
HCoop / bpt / emacs.git / blobdiff