+
+(defvar bookmark-bmenu-bookmark-column nil)
+
+
+(defvar bookmark-bmenu-hidden-bookmarks ())
+
+
+(defvar bookmark-bmenu-mode-map nil)
+
+
+(if bookmark-bmenu-mode-map
+ nil
+ (setq bookmark-bmenu-mode-map (make-keymap))
+ (suppress-keymap bookmark-bmenu-mode-map t)
+ (define-key bookmark-bmenu-mode-map "q" 'quit-window)
+ (define-key bookmark-bmenu-mode-map "v" 'bookmark-bmenu-select)
+ (define-key bookmark-bmenu-mode-map "w" 'bookmark-bmenu-locate)
+ (define-key bookmark-bmenu-mode-map "2" 'bookmark-bmenu-2-window)
+ (define-key bookmark-bmenu-mode-map "1" 'bookmark-bmenu-1-window)
+ (define-key bookmark-bmenu-mode-map "j" 'bookmark-bmenu-this-window)
+ (define-key bookmark-bmenu-mode-map "\C-c\C-c" 'bookmark-bmenu-this-window)
+ (define-key bookmark-bmenu-mode-map "f" 'bookmark-bmenu-this-window)
+ (define-key bookmark-bmenu-mode-map "\C-m" 'bookmark-bmenu-this-window)
+ (define-key bookmark-bmenu-mode-map "o" 'bookmark-bmenu-other-window)
+ (define-key bookmark-bmenu-mode-map "\C-o"
+ 'bookmark-bmenu-switch-other-window)
+ (define-key bookmark-bmenu-mode-map "s" 'bookmark-bmenu-save)
+ (define-key bookmark-bmenu-mode-map "k" 'bookmark-bmenu-delete)
+ (define-key bookmark-bmenu-mode-map "\C-d" 'bookmark-bmenu-delete-backwards)
+ (define-key bookmark-bmenu-mode-map "x" 'bookmark-bmenu-execute-deletions)
+ (define-key bookmark-bmenu-mode-map "d" 'bookmark-bmenu-delete)
+ (define-key bookmark-bmenu-mode-map " " 'next-line)
+ (define-key bookmark-bmenu-mode-map "n" 'next-line)
+ (define-key bookmark-bmenu-mode-map "p" 'previous-line)
+ (define-key bookmark-bmenu-mode-map "\177" 'bookmark-bmenu-backup-unmark)
+ (define-key bookmark-bmenu-mode-map "?" 'describe-mode)
+ (define-key bookmark-bmenu-mode-map "u" 'bookmark-bmenu-unmark)
+ (define-key bookmark-bmenu-mode-map "m" 'bookmark-bmenu-mark)
+ (define-key bookmark-bmenu-mode-map "l" 'bookmark-bmenu-load)
+ (define-key bookmark-bmenu-mode-map "r" 'bookmark-bmenu-rename)
+ (define-key bookmark-bmenu-mode-map "R" 'bookmark-bmenu-relocate)
+ (define-key bookmark-bmenu-mode-map "t" 'bookmark-bmenu-toggle-filenames)
+ (define-key bookmark-bmenu-mode-map "a" 'bookmark-bmenu-show-annotation)
+ (define-key bookmark-bmenu-mode-map "A" 'bookmark-bmenu-show-all-annotations)
+ (define-key bookmark-bmenu-mode-map "e" 'bookmark-bmenu-edit-annotation)
+ (define-key bookmark-bmenu-mode-map [mouse-2]
+ 'bookmark-bmenu-other-window-with-mouse))
+
+
+
+;; Bookmark Buffer Menu mode is suitable only for specially formatted
+;; data.
+(put 'bookmark-bmenu-mode 'mode-class 'special)
+
+
+;; todo: need to display whether or not bookmark exists as a buffer in
+;; flag column.
+
+;; Format:
+;; FLAGS BOOKMARK [ LOCATION ]
+
+
+(defun bookmark-bmenu-surreptitiously-rebuild-list ()
+ "Rebuild the Bookmark List if it exists.
+Don't affect the buffer ring order."
+ (if (get-buffer "*Bookmark List*")
+ (save-excursion
+ (save-window-excursion
+ (bookmark-bmenu-list)))))
+
+
+;;;###autoload
+(defun bookmark-bmenu-list ()
+ "Display a list of existing bookmarks.
+The list is displayed in a buffer named `*Bookmark List*'.
+The leftmost column displays a D if the bookmark is flagged for
+deletion, or > if it is flagged for displaying."
+ (interactive)
+ (bookmark-maybe-load-default-file)
+ (if (interactive-p)
+ (switch-to-buffer (get-buffer-create "*Bookmark List*"))
+ (set-buffer (get-buffer-create "*Bookmark List*")))
+ (let ((inhibit-read-only t))
+ (erase-buffer)
+ (insert "% Bookmark\n- --------\n")
+ (add-text-properties (point-min) (point)
+ '(font-lock-face bookmark-menu-heading))
+ (bookmark-maybe-sort-alist)
+ (mapcar
+ (lambda (full-record)
+ ;; if a bookmark has an annotation, prepend a "*"
+ ;; in the list of bookmarks.
+ (let ((annotation (bookmark-get-annotation
+ (bookmark-name-from-full-record full-record))))
+ (if (and annotation (not (string-equal annotation "")))
+ (insert " *")
+ (insert " "))
+ (let ((start (point)))
+ (insert (bookmark-name-from-full-record full-record))
+ (if (and (display-color-p) (display-mouse-p))
+ (add-text-properties
+ start
+ (save-excursion (re-search-backward
+ "[^ \t]")
+ (1+ (point)))
+ '(mouse-face highlight
+ follow-link t
+ help-echo "mouse-2: go to this bookmark in other window")))
+ (insert "\n")
+ )))
+ bookmark-alist))
+ (goto-char (point-min))
+ (forward-line 2)
+ (bookmark-bmenu-mode)
+ (if bookmark-bmenu-toggle-filenames
+ (bookmark-bmenu-toggle-filenames t)))
+
+;;;###autoload
+(defalias 'list-bookmarks 'bookmark-bmenu-list)
+;;;###autoload
+(defalias 'edit-bookmarks 'bookmark-bmenu-list)
+
+
+
+(defun bookmark-bmenu-mode ()
+ "Major mode for editing a list of bookmarks.
+Each line describes one of the bookmarks in Emacs.
+Letters do not insert themselves; instead, they are commands.
+Bookmark names preceded by a \"*\" have annotations.
+\\<bookmark-bmenu-mode-map>
+\\[bookmark-bmenu-mark] -- mark bookmark to be displayed.
+\\[bookmark-bmenu-select] -- select bookmark of line point is on.
+ Also show bookmarks marked using m in other windows.
+\\[bookmark-bmenu-toggle-filenames] -- toggle displaying of filenames (they may obscure long bookmark names).
+\\[bookmark-bmenu-locate] -- display (in minibuffer) location of this bookmark.
+\\[bookmark-bmenu-1-window] -- select this bookmark in full-frame window.
+\\[bookmark-bmenu-2-window] -- select this bookmark in one window,
+ together with bookmark selected before this one in another window.
+\\[bookmark-bmenu-this-window] -- select this bookmark in place of the bookmark menu buffer.
+\\[bookmark-bmenu-other-window] -- select this bookmark in another window,
+ so the bookmark menu bookmark remains visible in its window.
+\\[bookmark-bmenu-switch-other-window] -- switch the other window to this bookmark.
+\\[bookmark-bmenu-rename] -- rename this bookmark \(prompts for new name\).
+\\[bookmark-bmenu-relocate] -- relocate this bookmark's file \(prompts for new file\).
+\\[bookmark-bmenu-delete] -- mark this bookmark to be deleted, and move down.
+\\[bookmark-bmenu-delete-backwards] -- mark this bookmark to be deleted, and move up.
+\\[bookmark-bmenu-execute-deletions] -- delete bookmarks marked with `\\[bookmark-bmenu-delete]'.
+\\[bookmark-bmenu-save] -- save the current bookmark list in the default file.
+ With a prefix arg, prompts for a file to save in.
+\\[bookmark-bmenu-load] -- load in a file of bookmarks (prompts for file.)
+\\[bookmark-bmenu-unmark] -- remove all kinds of marks from current line.
+ With prefix argument, also move up one line.
+\\[bookmark-bmenu-backup-unmark] -- back up a line and remove marks.
+\\[bookmark-bmenu-show-annotation] -- show the annotation, if it exists, for the current bookmark
+ in another buffer.
+\\[bookmark-bmenu-show-all-annotations] -- show the annotations of all bookmarks in another buffer.
+\\[bookmark-bmenu-edit-annotation] -- edit the annotation for the current bookmark."
+ (kill-all-local-variables)
+ (use-local-map bookmark-bmenu-mode-map)
+ (setq truncate-lines t)
+ (setq buffer-read-only t)
+ (setq major-mode 'bookmark-bmenu-mode)
+ (setq mode-name "Bookmark Menu")
+ (run-mode-hooks 'bookmark-bmenu-mode-hook))
+
+
+(defun bookmark-bmenu-toggle-filenames (&optional show)
+ "Toggle whether filenames are shown in the bookmark list.
+Optional argument SHOW means show them unconditionally."
+ (interactive)
+ (cond
+ (show
+ (setq bookmark-bmenu-toggle-filenames nil)
+ (bookmark-bmenu-show-filenames)
+ (setq bookmark-bmenu-toggle-filenames t))
+ (bookmark-bmenu-toggle-filenames
+ (bookmark-bmenu-hide-filenames)
+ (setq bookmark-bmenu-toggle-filenames nil))
+ (t
+ (bookmark-bmenu-show-filenames)
+ (setq bookmark-bmenu-toggle-filenames t))))
+
+
+(defun bookmark-bmenu-show-filenames (&optional force)
+ (if (and (not force) bookmark-bmenu-toggle-filenames)
+ nil ;already shown, so do nothing
+ (save-excursion
+ (save-window-excursion
+ (goto-char (point-min))
+ (forward-line 2)
+ (setq bookmark-bmenu-hidden-bookmarks ())
+ (let ((inhibit-read-only t))
+ (while (< (point) (point-max))
+ (let ((bmrk (bookmark-bmenu-bookmark)))
+ (setq bookmark-bmenu-hidden-bookmarks
+ (cons bmrk bookmark-bmenu-hidden-bookmarks))
+ (let ((start (save-excursion (end-of-line) (point))))
+ (move-to-column bookmark-bmenu-file-column t)
+ ;; Strip off `mouse-face' from the white spaces region.
+ (if (and (display-color-p) (display-mouse-p))
+ (remove-text-properties start (point)
+ '(mouse-face nil help-echo nil))))
+ (delete-region (point) (progn (end-of-line) (point)))
+ (insert " ")
+ ;; Pass the NO-HISTORY arg:
+ (bookmark-insert-location bmrk t)
+ (forward-line 1))))))))
+
+
+(defun bookmark-bmenu-hide-filenames (&optional force)
+ (if (and (not force) bookmark-bmenu-toggle-filenames)
+ ;; nothing to hide if above is nil
+ (save-excursion
+ (save-window-excursion
+ (goto-char (point-min))
+ (forward-line 2)
+ (setq bookmark-bmenu-hidden-bookmarks
+ (nreverse bookmark-bmenu-hidden-bookmarks))
+ (save-excursion
+ (goto-char (point-min))
+ (search-forward "Bookmark")
+ (backward-word 1)
+ (setq bookmark-bmenu-bookmark-column (current-column)))
+ (save-excursion
+ (let ((inhibit-read-only t))
+ (while bookmark-bmenu-hidden-bookmarks
+ (move-to-column bookmark-bmenu-bookmark-column t)
+ (bookmark-kill-line)
+ (let ((start (point)))
+ (insert (car bookmark-bmenu-hidden-bookmarks))
+ (if (and (display-color-p) (display-mouse-p))
+ (add-text-properties
+ start
+ (save-excursion (re-search-backward
+ "[^ \t]")
+ (1+ (point)))
+ '(mouse-face highlight
+ follow-link t
+ help-echo
+ "mouse-2: go to this bookmark in other window"))))
+ (setq bookmark-bmenu-hidden-bookmarks
+ (cdr bookmark-bmenu-hidden-bookmarks))
+ (forward-line 1))))))))
+
+
+(defun bookmark-bmenu-check-position ()
+ ;; 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)
+ bookmark-alist)
+ ((and (bolp) (eobp))
+ (beginning-of-line 0)
+ bookmark-alist)
+ (t
+ bookmark-alist)))
+
+
+(defun bookmark-bmenu-bookmark ()
+ ;; return a string which is bookmark of this line.
+ (if (bookmark-bmenu-check-position)
+ (save-excursion
+ (save-window-excursion
+ (goto-char (point-min))
+ (search-forward "Bookmark")
+ (backward-word 1)
+ (setq bookmark-bmenu-bookmark-column (current-column)))))
+ (if bookmark-bmenu-toggle-filenames
+ (bookmark-bmenu-hide-filenames))
+ (save-excursion
+ (save-window-excursion
+ (beginning-of-line)
+ (forward-char bookmark-bmenu-bookmark-column)
+ (prog1
+ (buffer-substring-no-properties (point)
+ (progn
+ (end-of-line)
+ (point)))
+ ;; well, this is certainly crystal-clear:
+ (if bookmark-bmenu-toggle-filenames
+ (bookmark-bmenu-toggle-filenames t))))))
+
+
+(defun bookmark-show-annotation (bookmark)
+ "Display the annotation for bookmark named BOOKMARK in a buffer,
+if an annotation exists."
+ (let ((annotation (bookmark-get-annotation bookmark)))
+ (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 ()
+ "Display the annotations for all bookmarks in a buffer."
+ (let ((old-buf (current-buffer)))
+ (pop-to-buffer (get-buffer-create "*Bookmark Annotation*") t)
+ (delete-region (point-min) (point-max))
+ (mapcar
+ (lambda (full-record)
+ (let* ((name (bookmark-name-from-full-record full-record))
+ (ann (bookmark-get-annotation name)))
+ (insert (concat name ":\n"))
+ (if (and ann (not (string-equal ann "")))
+ ;; insert the annotation, indented by 4 spaces.
+ (progn
+ (save-excursion (insert ann))
+ (while (< (point) (point-max))
+ (beginning-of-line) ; paranoia
+ (insert " ")
+ (forward-line)
+ (end-of-line))))))
+ bookmark-alist)
+ (goto-char (point-min))
+ (pop-to-buffer old-buf)))
+
+
+(defun bookmark-bmenu-mark ()
+ "Mark bookmark on this line to be displayed by \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-select]."
+ (interactive)
+ (beginning-of-line)
+ (if (bookmark-bmenu-check-position)
+ (let ((inhibit-read-only t))
+ (delete-char 1)
+ (insert ?>)
+ (forward-line 1)
+ (bookmark-bmenu-check-position))))
+
+
+(defun bookmark-bmenu-select ()
+ "Select this line's bookmark; also display bookmarks marked with `>'.
+You can mark bookmarks with the \\<bookmark-bmenu-mode-map>\\[bookmark-bmenu-mark] command."
+ (interactive)
+ (if (bookmark-bmenu-check-position)
+ (let ((bmrk (bookmark-bmenu-bookmark))
+ (menu (current-buffer))
+ (others ())
+ tem)
+ (goto-char (point-min))
+ (while (re-search-forward "^>" nil t)
+ (setq tem (bookmark-bmenu-bookmark))
+ (let ((inhibit-read-only t))
+ (delete-char -1)
+ (insert ?\s))
+ (or (string-equal tem bmrk)
+ (member tem others)
+ (setq others (cons tem others))))
+ (setq others (nreverse others)
+ tem (/ (1- (frame-height)) (1+ (length others))))
+ (delete-other-windows)
+ (bookmark-jump bmrk)
+ (bury-buffer menu)
+ (if others
+ (while others
+ (split-window nil tem)
+ (other-window 1)
+ (bookmark-jump (car others))
+ (setq others (cdr others)))
+ (other-window 1)))))
+
+
+(defun bookmark-bmenu-save (parg)
+ "Save the current list into a bookmark file.
+With a prefix arg, prompts for a file to save them in."
+ (interactive "P")
+ (save-excursion
+ (save-window-excursion
+ (bookmark-save parg))))
+
+
+(defun bookmark-bmenu-load ()
+ "Load the bookmark file and rebuild the bookmark menu-buffer."
+ (interactive)
+ (if (bookmark-bmenu-check-position)
+ (save-excursion
+ (save-window-excursion
+ ;; This will call `bookmark-bmenu-list'
+ (call-interactively 'bookmark-load)))))
+
+
+(defun bookmark-bmenu-1-window ()
+ "Select this line's bookmark, alone, in full frame."
+ (interactive)
+ (if (bookmark-bmenu-check-position)
+ (progn
+ (bookmark-jump (bookmark-bmenu-bookmark))
+ (bury-buffer (other-buffer))
+ (delete-other-windows))))
+
+
+(defun bookmark-bmenu-2-window ()
+ "Select this line's bookmark, with previous buffer in second window."
+ (interactive)
+ (if (bookmark-bmenu-check-position)
+ (let ((bmrk (bookmark-bmenu-bookmark))
+ (menu (current-buffer))
+ (pop-up-windows t))
+ (delete-other-windows)
+ (switch-to-buffer (other-buffer))
+ (let* ((pair (bookmark-jump-noselect bmrk))
+ (buff (car pair))
+ (pos (cdr pair)))
+ (pop-to-buffer buff)
+ (goto-char pos))
+ (bury-buffer menu))))
+
+
+(defun bookmark-bmenu-this-window ()
+ "Select this line's bookmark in this window."
+ (interactive)
+ (if (bookmark-bmenu-check-position)
+ (bookmark-jump (bookmark-bmenu-bookmark))))
+
+
+(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-noselect 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)))))
+
+
+(defun bookmark-bmenu-switch-other-window ()
+ "Make the other window select this line's bookmark.
+The current window remains selected."
+ (interactive)
+ (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-noselect 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)
+ (set-window-point (get-buffer-window buff) pos)
+ (set-buffer o-buffer))
+ (bookmark-show-annotation bookmark)))))
+
+(defun bookmark-bmenu-other-window-with-mouse (event)
+ "Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."