;;; 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."
(defvar bookmark-current-buffer nil
"The buffer in which a bookmark is currently being set or renamed.
Functions that insert strings into the minibuffer use this to know
-the source buffer for that information; see `bookmark-yank-word' and
-`bookmark-insert-current-bookmark' for example.")
+the source buffer for that information; see `bookmark-yank-word'
+for example.")
(defvar bookmark-yank-point 0
": ")))
(str
(completing-read prompt
- bookmark-alist
+ (lambda (string pred action)
+ (if (eq action 'metadata)
+ '(metadata (category . bookmark))
+ (complete-with-action
+ action bookmark-alist string pred)))
nil
0
nil
(defun bookmark-make-record ()
"Return a new bookmark record (NAME . ALIST) for the current location."
(let ((record (funcall bookmark-make-record-function)))
+ ;; Set up defaults.
+ (bookmark-prop-set
+ record 'defaults
+ (delq nil (delete-dups (append (bookmark-prop-get record 'defaults)
+ (list bookmark-current-bookmark
+ (bookmark-buffer-name))))))
;; Set up default name.
(if (stringp (car record))
;; The function already provided a default name.
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-map)
(define-key map "\C-w" 'bookmark-yank-word)
- ;; This C-u binding might not be very useful any more now that we
- ;; provide access to the default via the standard M-n binding.
- ;; Maybe we should just remove it? --Stef-08
- (define-key map "\C-u" 'bookmark-insert-current-bookmark)
map))
;;;###autoload
(interactive (list nil current-prefix-arg))
(unwind-protect
(let* ((record (bookmark-make-record))
- (default (car record)))
+ ;; `defaults' is a transient element of the
+ ;; extensible format described above in the section
+ ;; `File format stuff'. Bookmark record functions
+ ;; can use it to specify a list of default values
+ ;; accessible via M-n while reading a bookmark name.
+ (defaults (bookmark-prop-get record 'defaults))
+ (default (if (consp defaults) (car defaults) defaults)))
+
+ (if defaults
+ ;; Don't store default values in the record.
+ (setq record (assq-delete-all 'defaults record))
+ ;; When no defaults in the record, use its first element.
+ (setq defaults (car record) default defaults))
(bookmark-maybe-load-default-file)
;; Don't set `bookmark-yank-point' and `bookmark-current-buffer'
(format "Set bookmark (%s): " default)
nil
bookmark-minibuffer-read-name-map
- nil nil default))))
+ nil nil defaults))))
(and (string-equal str "") (setq str default))
(bookmark-store str (cdr record) no-overwrite)
(bookmark-edit-annotation-mode bookmark-name-or-record))
-(defun bookmark-insert-current-bookmark ()
- "Insert into the bookmark name currently being set the value of
-`bookmark-current-bookmark' in `bookmark-current-buffer', defaulting
-to the buffer's file name if `bookmark-current-bookmark' is nil."
- (interactive)
- (let ((str
- (with-current-buffer bookmark-current-buffer
- (or bookmark-current-bookmark
- (bookmark-buffer-name)))))
- (insert str)))
-
-
(defun bookmark-buffer-name ()
"Return the name of the current buffer in a form usable as a bookmark name.
If the buffer is associated with a file or directory, use that name."
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