;;; bookmark.el --- set bookmarks, maybe annotate them, jump to them later
-;; Copyright (C) 1993-1997, 2001-2012 Free Software Foundation, Inc.
+;; Copyright (C) 1993-1997, 2001-2013 Free Software Foundation, Inc.
;; Author: Karl Fogel <kfogel@red-bean.com>
;; Maintainer: Karl Fogel <kfogel@red-bean.com>
(defcustom bookmark-version-control 'nospecial
"Whether or not to make numbered backups of the bookmark file.
-It can have four values: t, nil, `never', and `nospecial'.
+It can have four values: t, nil, `never', or `nospecial'.
The first three have the same meaning that they do for the
-variable `version-control', and the final value `nospecial' means just
-use the value of `version-control'."
- :type '(choice (const nil) (const never) (const nospecial)
- (other t))
+variable `version-control'; the value `nospecial' (the default) means
+just use the value of `version-control'."
+ :type '(choice (const :tag "If existing" nil)
+ (const :tag "Never" never)
+ (const :tag "Use value of option `version-control'" nospecial)
+ (other :tag "Always" t))
:group 'bookmark)
:type 'boolean
:group 'bookmark)
+(defcustom bookmark-bmenu-use-header-line t
+ "Non-nil means to use an immovable header line, as opposed to inline
+text at the top of the buffer."
+ :type 'boolean
+ :group 'bookmark)
-(defconst bookmark-bmenu-header-height 2
- "Number of lines used for the *Bookmark List* header.")
+(defconst bookmark-bmenu-inline-header-height 2
+ "Number of lines used for the *Bookmark List* header
+\(only significant when `bookmark-bmenu-use-header-line' is nil\).")
(defconst bookmark-bmenu-marks-width 2
"Number of columns (chars) used for the *Bookmark List* marks column,
(defcustom bookmark-bmenu-toggle-filenames t
"Non-nil means show filenames when listing bookmarks.
-This may result in truncated bookmark names. To disable this, put the
-following in your `.emacs' file:
-
-\(setq bookmark-bmenu-toggle-filenames nil)"
+A non-nil value may result in truncated bookmark names."
:type 'boolean
:group 'bookmark)
+(defface bookmark-menu-bookmark
+ '((t (:weight bold)))
+ "Face used to highlight bookmark names in bookmark menu buffers."
+ :group 'bookmark)
(defcustom bookmark-menu-length 70
"Maximum length of a bookmark name displayed on a popup menu."
"Prompting with PROMPT, read a bookmark name in completion.
PROMPT will get a \": \" stuck on the end no matter what, so you
probably don't want to include one yourself.
-Optional second arg DEFAULT is a string to return if the user enters
-the empty string."
+Optional arg DEFAULT is a string to return if the user input is empty.
+If DEFAULT is nil then return empty string for empty input."
(bookmark-maybe-load-default-file) ; paranoia
(if (listp last-nonmenu-event)
(bookmark-menu-popup-paned-menu t prompt
'string-lessp)
(bookmark-all-names)))
(let* ((completion-ignore-case bookmark-completion-ignore-case)
- (default default)
+ (default (unless (equal "" default) default))
(prompt (concat prompt (if default
(format " (%s): " default)
- ": ")))
- (str
- (completing-read prompt
- bookmark-alist
- nil
- 0
- nil
- 'bookmark-history)))
- (if (string-equal "" str) default str))))
+ ": "))))
+ (completing-read prompt
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (category . bookmark))
+ (complete-with-action
+ action bookmark-alist string pred)))
+ nil 0 nil 'bookmark-history default))))
(defmacro bookmark-maybe-historicize-string (string)
Note: this function is deprecated and is present for Emacs 22
compatibility only."
+ (declare (obsolete bookmark-handle-bookmark "23.1"))
(save-excursion
(bookmark-handle-bookmark bookmark)
(cons (current-buffer) (point))))
-(make-obsolete 'bookmark-jump-noselect 'bookmark-handle-bookmark "23.1")
-
(defun bookmark-handle-bookmark (bookmark-name-or-record)
"Call BOOKMARK-NAME-OR-RECORD's handler or `bookmark-default-handler'
if it has none. This changes current buffer and point and returns nil,
minibuffer history list `bookmark-history'."
(interactive (list (bookmark-completing-read "Insert bookmark location")))
(or no-history (bookmark-maybe-historicize-string bookmark-name))
- (let ((start (point)))
- (prog1
- (insert (bookmark-location bookmark-name))
- (if (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 (bookmark-location bookmark-name)))
;;;###autoload
(defalias 'bookmark-locate 'bookmark-insert-location)
(goto-char (point-min))
(delete-region (point-min) (point-max))
(let ((print-length nil)
- (print-level nil))
+ (print-level nil)
+ ;; See bug #12503 for why we bind `print-circle'. Users
+ ;; can define their own bookmark types, which can result in
+ ;; arbitrary Lisp objects being stored in bookmark records,
+ ;; and some users create objects containing circularities.
+ (print-circle t))
(bookmark-insert-file-format-version-stamp)
(insert "(")
;; Rather than a single call to `pp' we make one per bookmark.
(set-buffer buf)))
(let ((inhibit-read-only t))
(erase-buffer)
- (insert "% Bookmark\n- --------\n")
+ (if (not bookmark-bmenu-use-header-line)
+ (insert "% Bookmark\n- --------\n"))
(add-text-properties (point-min) (point)
'(font-lock-face bookmark-menu-heading))
(dolist (full-record (bookmark-maybe-sort-alist))
(when (display-mouse-p)
(add-text-properties
(+ bookmark-bmenu-marks-width start) end
- '(mouse-face highlight
+ '(font-lock-face bookmark-menu-bookmark
+ mouse-face highlight
follow-link t
help-echo "mouse-2: go to this bookmark in other window")))
(insert "\n")))
(set-buffer-modified-p (not (= bookmark-alist-modification-count 0)))
(goto-char (point-min))
- (forward-line 2)
(bookmark-bmenu-mode)
- (if bookmark-bmenu-toggle-filenames
- (bookmark-bmenu-toggle-filenames t))))
+ (if bookmark-bmenu-use-header-line
+ (bookmark-bmenu-set-header)
+ (forward-line bookmark-bmenu-inline-header-height))
+ (when (and bookmark-alist 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-set-header ()
+ "Sets the immutable header line."
+ (let ((header (concat "%% " "Bookmark")))
+ (when bookmark-bmenu-toggle-filenames
+ (setq header (concat header
+ (make-string (- bookmark-bmenu-file-column
+ (- (length header) 3)) ?\s)
+ "File")))
+ (let ((pos 0))
+ (while (string-match "[ \t\n]+" header pos)
+ (setq pos (match-end 0))
+ (put-text-property (match-beginning 0) pos 'display
+ (list 'space :align-to (- pos 1))
+ header)))
+ (put-text-property 0 2 'face 'fixed-pitch header)
+ (setq header (concat (propertize " " 'display '(space :align-to 0))
+ header))
+ ;; Code derived from `buff-menu.el'.
+ (setq header-line-format header)))
(define-derived-mode bookmark-bmenu-mode special-mode "Bookmark Menu"
"Major mode for editing a list of bookmarks.
(setq bookmark-bmenu-toggle-filenames nil))
(t
(bookmark-bmenu-show-filenames)
- (setq bookmark-bmenu-toggle-filenames t))))
+ (setq bookmark-bmenu-toggle-filenames t)))
+ (when bookmark-bmenu-use-header-line
+ (bookmark-bmenu-set-header)))
(defun bookmark-bmenu-show-filenames (&optional force)
(save-excursion
(save-window-excursion
(goto-char (point-min))
- (forward-line 2)
+ (if (not bookmark-bmenu-use-header-line)
+ (forward-line bookmark-bmenu-inline-header-height))
(setq bookmark-bmenu-hidden-bookmarks ())
(let ((inhibit-read-only t))
(while (< (point) (point-max))
(with-buffer-modified-unmodified
(save-excursion
(goto-char (point-min))
- (forward-line 2)
+ (if (not bookmark-bmenu-use-header-line)
+ (forward-line bookmark-bmenu-inline-header-height))
(setq bookmark-bmenu-hidden-bookmarks
(nreverse bookmark-bmenu-hidden-bookmarks))
(let ((inhibit-read-only t))
(if (display-mouse-p)
(add-text-properties
start (point)
- '(mouse-face
- highlight follow-link t help-echo
+ '(font-lock-face bookmark-menu-bookmark
+ mouse-face highlight
+ follow-link t help-echo
"mouse-2: go to this bookmark in other window"))))
(forward-line 1)))))))
"If point is not on a bookmark line, move it to one.
If before the first bookmark line, move to the first; if after the
last full line, move to the last full line. The return value is undefined."
- (cond ((< (count-lines (point-min) (point)) bookmark-bmenu-header-height)
+ (cond ((and (not bookmark-bmenu-use-header-line)
+ (< (count-lines (point-min) (point))
+ bookmark-bmenu-inline-header-height))
(goto-char (point-min))
- (forward-line bookmark-bmenu-header-height))
+ (forward-line bookmark-bmenu-inline-header-height))
((and (bolp) (eobp))
(beginning-of-line 0))))
The current window remains selected."
(interactive)
(let ((bookmark (bookmark-bmenu-bookmark))
- (pop-up-windows t)
- same-window-buffer-names
- same-window-regexps)
- (bookmark--jump-via bookmark 'display-buffer)))
+ (fun (lambda (b) (display-buffer b t))))
+ (bookmark--jump-via bookmark fun)))
(defun bookmark-bmenu-other-window-with-mouse (event)
"Select bookmark at the mouse pointer in other window, leaving bookmark menu visible."
(progn (end-of-line) (point))))))
(o-col (current-column)))
(goto-char (point-min))
- (forward-line 1)
+ (unless bookmark-bmenu-use-header-line
+ (forward-line 1))
(while (re-search-forward "^D" (point-max) t)
(bookmark-delete (bookmark-bmenu-bookmark) t)) ; pass BATCH arg
(bookmark-bmenu-list)
;;; Bookmark-bmenu search
-;; Store keyboard input for incremental search.
-(defvar bookmark-search-pattern)
-
-(defun bookmark-read-search-input ()
- "Read each keyboard input and add it to `bookmark-search-pattern'."
- (let ((prompt (propertize "Pattern: " 'face 'minibuffer-prompt))
- ;; (inhibit-quit t) ; inhibit-quit is evil. Use it with extreme care!
- (tmp-list ()))
- (while
- (let ((char (read-key (concat prompt bookmark-search-pattern))))
- (pcase char
- ((or ?\e ?\r) nil) ; RET or ESC break the search loop.
- (?\C-g (setq bookmark-quit-flag t) nil)
- (?\d (pop tmp-list) t) ; Delete last char of pattern with DEL
- (_
- (if (characterp char)
- (push char tmp-list)
- (setq unread-command-events
- (nconc (mapcar 'identity
- (this-single-command-raw-keys))
- unread-command-events))
- nil))))
- (setq bookmark-search-pattern
- (apply 'string (reverse tmp-list))))))
-
-
(defun bookmark-bmenu-filter-alist-by-regexp (regexp)
"Filter `bookmark-alist' with bookmarks matching REGEXP and rebuild list."
(let ((bookmark-alist
"Incremental search of bookmarks, hiding the non-matches as we go."
(interactive)
(let ((bmk (bookmark-bmenu-bookmark))
- (bookmark-search-pattern "")
- (timer (run-with-idle-timer
- bookmark-search-delay 'repeat
- #'(lambda ()
- (bookmark-bmenu-filter-alist-by-regexp
- bookmark-search-pattern)))))
+ (timer nil))
(unwind-protect
- (bookmark-read-search-input)
- (cancel-timer timer)
- (message nil)
- (when bookmark-quit-flag ; C-g hit restore menu list.
- (bookmark-bmenu-list) (bookmark-bmenu-goto-bookmark bmk))
- (setq bookmark-quit-flag nil))))
+ (minibuffer-with-setup-hook
+ (lambda ()
+ (setq timer (run-with-idle-timer
+ bookmark-search-delay 'repeat
+ #'(lambda (buf)
+ (with-current-buffer buf
+ (bookmark-bmenu-filter-alist-by-regexp
+ (minibuffer-contents))))
+ (current-buffer))))
+ (read-string "Pattern: ")
+ (when timer (cancel-timer timer) (setq timer nil)))
+ (when timer ;; Signalled an error or a `quit'.
+ (cancel-timer timer)
+ (bookmark-bmenu-list)
+ (bookmark-bmenu-goto-bookmark bmk)))))
(defun bookmark-bmenu-goto-bookmark (name)
"Move point to bookmark with name NAME."
"Save bookmark state, if necessary, at Emacs exit time.
This also runs `bookmark-exit-hook'."
(run-hooks 'bookmark-exit-hook)
- (and bookmark-alist
- (bookmark-time-to-save-p t)
+ (and (bookmark-time-to-save-p t)
(bookmark-save)))
(unless noninteractive
HCoop / bpt / emacs.git / blobdiff