;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 2001, 2002, 2003,
-;; 2004, 2005 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))
;; Read the help on all of these functions for details...
;;;###autoload (define-key bookmark-map "x" 'bookmark-set)
-;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ; "m" for "mark"
+;;;###autoload (define-key bookmark-map "m" 'bookmark-set) ;"m"ark
;;;###autoload (define-key bookmark-map "j" 'bookmark-jump)
-;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ; "g" for "go"
+;;;###autoload (define-key bookmark-map "g" 'bookmark-jump) ;"g"o
+;;;###autoload (define-key bookmark-map "o" 'bookmark-jump-other-window)
;;;###autoload (define-key bookmark-map "i" 'bookmark-insert)
;;;###autoload (define-key bookmark-map "e" 'edit-bookmarks)
-;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ; "f" for "find"
+;;;###autoload (define-key bookmark-map "f" 'bookmark-insert-location) ;"f"ind
;;;###autoload (define-key bookmark-map "r" 'bookmark-rename)
;;;###autoload (define-key bookmark-map "d" 'bookmark-delete)
;;;###autoload (define-key bookmark-map "l" 'bookmark-load)
(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?
(defun bookmark-buffer-file-name ()
"Return the current buffer's file in a way useful for bookmarks.
For example, if this is a Info buffer, return the Info file's name."
- (if (eq major-mode 'Info-mode)
- Info-current-file
- (or
- buffer-file-name
- (if (and (boundp 'dired-directory) dired-directory)
- (if (stringp dired-directory)
- dired-directory
- (car dired-directory))))))
+ (cond
+ ((eq major-mode 'Info-mode)
+ Info-current-file)
+ (buffer-file-name
+ ;; Abbreviate the path, both so it's shorter and so it's more
+ ;; portable. E.g., the user's home dir might be a different
+ ;; path on different machines, but "~/" will still reach it.
+ (abbreviate-file-name buffer-file-name))
+ ((and (boundp 'dired-directory) dired-directory)
+ (if (stringp dired-directory)
+ dired-directory
+ (car dired-directory)))))
(defun bookmark-maybe-load-default-file ()
;;Return the bookmark-alist for display. If the bookmark-sort-flag
;;is non-nil, then return a sorted copy of the alist.
(if bookmark-sort-flag
- (setq bookmark-alist
- (sort (copy-alist bookmark-alist)
- (function
- (lambda (x y) (string-lessp (car x) (car y))))))))
+ (sort (copy-alist bookmark-alist)
+ (function
+ (lambda (x y) (string-lessp (car x) (car y)))))
+ bookmark-alist))
(defvar bookmark-after-jump-hook nil
(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,
(bookmark-show-annotation bookmark)))))
+;;;###autoload
+(defun bookmark-jump-other-window (bookmark)
+ "Jump to BOOKMARK (a point in some file) in another window.
+See `bookmark-jump'."
+ (interactive
+ (let ((bkm (bookmark-completing-read "Jump to bookmark (in another window)"
+ bookmark-current-bookmark)))
+ (if (> emacs-major-version 21)
+ (list bkm) bkm)))
+ (when bookmark
+ (bookmark-maybe-historicize-string bookmark)
+ (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.
+ (bookmark-show-annotation bookmark))))))
+
+
(defun bookmark-file-or-variation-thereof (file)
"Return FILE (a string) if it exists, or return a reasonable
variation of FILE if that exists. Reasonable variations are checked
;; 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))
- (bookmark-maybe-sort-alist)
- (mapcar
+ (mapc
(lambda (full-record)
;; if a bookmark has an annotation, prepend a "*"
;; in the list of bookmarks.
help-echo "mouse-2: go to this bookmark in other window")))
(insert "\n")
)))
- bookmark-alist))
+ (bookmark-maybe-sort-alist)))
(goto-char (point-min))
(forward-line 2)
(bookmark-bmenu-mode)
(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)))
(if (and ann (not (string-equal ann "")))
;; insert the annotation, indented by 4 spaces.
(progn
- (save-excursion (insert ann))
+ (save-excursion (insert ann) (unless (bolp)
+ (insert "\n")))
(while (< (point) (point-max))
(beginning-of-line) ; paranoia
(insert " ")
(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