comparison lisp/bookmark.el @ 91327:606f2d163a64

Merge from emacs--devo--0 Revision: [e-mail]/emacs--unicode--0--patch-312

91326:b1a63d7fa09c

;;; 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.

;; Author: Karl Fogel <[e-mail]>
;; Maintainer: Karl Fogel <[e-mail]>
;; Created: July, 1993
;; Keywords: bookmarks, placeholders, annotations

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'.
It should return a cons (BUFFER . POINT) indicating buffer
showing the bookmarked location and the value of point in that
buffer.  Like `bookmark-jump-noselect' the buffer shouldn't be
selected by the handler.")

(defun bookmark-make (name &optional annotation overwrite info-node)
  "Make a bookmark named NAME.
Optional second arg ANNOTATION gives it an annotation.
Optional third arg OVERWRITE means replace any existing bookmarks with

(defun bookmark-buffer-name ()
  "Return the name of the current buffer's file, non-directory.
In Info, return the current node."
  (cond
   ;; Are we in Info?
   ((string-equal mode-name "Info") Info-current-node)
   ;; Or are we a file?
   (buffer-file-name (file-name-nondirectory buffer-file-name))
   ;; Or are we a directory?
   ((and (boundp 'dired-directory) dired-directory)
    (let* ((dirname (if (stringp dired-directory)

   (list (bookmark-completing-read "Jump to bookmark"
				   bookmark-current-bookmark)))
  (unless bookmark
    (error "No bookmark specified"))
  (bookmark-maybe-historicize-string bookmark)
  (let ((cell (bookmark-jump-internal bookmark)))
    (and cell
         (switch-to-buffer (car cell))
         (goto-char (cdr cell))
	 (progn (run-hooks 'bookmark-after-jump-hook) t)
	 (if bookmark-automatically-show-annotations
             ;; if there is an annotation for this bookmark,
             ;; show it in a buffer.
             (bookmark-show-annotation bookmark)))))

                                        bookmark-current-bookmark)))
     (if (> emacs-major-version 21)
         (list bkm) bkm)))
  (when bookmark
    (bookmark-maybe-historicize-string bookmark)
    (let ((cell (bookmark-jump-internal bookmark)))
      (and cell
           (switch-to-buffer-other-window (car cell))
           (goto-char (cdr cell))
           (if bookmark-automatically-show-annotations
               ;; if there is an annotation for this bookmark,
               ;; show it in a buffer.
               (bookmark-show-annotation bookmark))))))

  (funcall (or (bookmark-get-handler bookmark)
	       'bookmark-jump-noselect)
	   bookmark))

(defun bookmark-jump-noselect (str)
  ;; a leetle helper for bookmark-jump :-)
  ;; returns (BUFFER . POINT)
  (bookmark-maybe-load-default-file)
  (let* ((file (expand-file-name (bookmark-get-filename str)))
         (forward-str            (bookmark-get-front-context-string str))
         (behind-str             (bookmark-get-rear-context-string str))
         (place                  (bookmark-get-position str))

            (if behind-str
                (if (search-backward behind-str (point-min) t)
                    (goto-char (match-end 0))))
            ;; added by db
            (setq bookmark-current-bookmark str)
            (cons (current-buffer) (point))))

      ;; 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)

  (bookmark-maybe-historicize-string bookmark)
  (bookmark-maybe-load-default-file)
  (let ((orig-point (point))
	(str-to-insert
	 (save-excursion
	   (set-buffer (car (bookmark-jump-internal bookmark)))
	   (buffer-string))))
    (insert str-to-insert)
    (push-mark)
    (goto-char orig-point)))

      (let ((bmrk (bookmark-bmenu-bookmark))
            (menu (current-buffer))
            (pop-up-windows t))
        (delete-other-windows)
        (switch-to-buffer (other-buffer))
	(let* ((pair (bookmark-jump-internal bmrk))
               (buff (car pair))
               (pos  (cdr pair)))
          (pop-to-buffer buff)
          (goto-char pos))
        (bury-buffer menu))))

(defun bookmark-bmenu-other-window ()
  "Select this line's bookmark in other window, leaving bookmark menu visible."
  (interactive)
  (let ((bookmark (bookmark-bmenu-bookmark)))
    (if (bookmark-bmenu-check-position)
	(let* ((pair (bookmark-jump-internal bookmark))
               (buff (car pair))
               (pos  (cdr pair)))
	  (switch-to-buffer-other-window buff)
          (goto-char pos)
          (set-window-point (get-buffer-window buff) pos)
	  (bookmark-show-annotation bookmark)))))

  (let ((bookmark (bookmark-bmenu-bookmark))
        (pop-up-windows t)
        same-window-buffer-names
        same-window-regexps)
    (if (bookmark-bmenu-check-position)
	(let* ((pair (bookmark-jump-internal bookmark))
               (buff (car pair))
               (pos  (cdr pair)))
	  (display-buffer buff)
          (let ((o-buffer (current-buffer)))
            ;; save-excursion won't do
            (set-buffer buff)
            (goto-char pos)

(run-hooks 'bookmark-load-hook)

(provide 'bookmark)

;;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
;;; bookmark.el ends here

91327:606f2d163a64

;;; 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, 2008 Free Software Foundation, Inc.

;; Author: Karl Fogel <[e-mail]>
;; Maintainer: Karl Fogel <[e-mail]>
;; Created: July, 1993
;; Keywords: bookmarks, placeholders, annotations

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.
Optional second arg ANNOTATION gives it an annotation.
Optional third arg OVERWRITE means replace any existing bookmarks with

(defun bookmark-buffer-name ()
  "Return the name of the current buffer's file, non-directory.
In Info, return the current node."
  (cond
   ;; Are we in Info?
   ((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?
   ((and (boundp 'dired-directory) dired-directory)
    (let* ((dirname (if (stringp dired-directory)

   (list (bookmark-completing-read "Jump to bookmark"
				   bookmark-current-bookmark)))
  (unless bookmark
    (error "No bookmark specified"))
  (bookmark-maybe-historicize-string bookmark)
  (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,
             ;; show it in a buffer.
             (bookmark-show-annotation bookmark)))))

                                        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))))))

  (funcall (or (bookmark-get-handler bookmark)
	       'bookmark-jump-noselect)
	   bookmark))

(defun bookmark-jump-noselect (str)
  ;; 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))
         (behind-str             (bookmark-get-rear-context-string str))
         (place                  (bookmark-get-position str))

            (if behind-str
                (if (search-backward behind-str (point-min) t)
                    (goto-char (match-end 0))))
            ;; added by db
            (setq bookmark-current-bookmark str)
            `((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.
      (ding)
      (if (y-or-n-p (concat (file-name-nondirectory orig-file)

  (bookmark-maybe-historicize-string bookmark)
  (bookmark-maybe-load-default-file)
  (let ((orig-point (point))
	(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)))

      (let ((bmrk (bookmark-bmenu-bookmark))
            (menu (current-buffer))
            (pop-up-windows t))
        (delete-other-windows)
        (switch-to-buffer (other-buffer))
	(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))))

(defun bookmark-bmenu-other-window ()
  "Select this line's bookmark in other window, leaving bookmark menu visible."
  (interactive)
  (let ((bookmark (bookmark-bmenu-bookmark)))
    (if (bookmark-bmenu-check-position)
	(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)
	  (bookmark-show-annotation bookmark)))))

  (let ((bookmark (bookmark-bmenu-bookmark))
        (pop-up-windows t)
        same-window-buffer-names
        same-window-regexps)
    (if (bookmark-bmenu-check-position)
	(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
            (set-buffer buff)
            (goto-char pos)

(run-hooks 'bookmark-load-hook)

(provide 'bookmark)

;; arch-tag: 139f519a-dd0c-4b8d-8b5d-f9fcf53ca8f6
;;; bookmark.el ends here