summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorPaul M. Rodriguez <paulmrodriguez@gmail.com>2011-06-28 15:42:23 +0200
committerBastien Guerry <bzg@altern.org>2011-06-28 15:42:23 +0200
commitfd2a82743d674442f3c8c8e7280b3a1d65303f2f (patch)
treeef0db50847fc93f9c8ff57c8838c56fdbe241c83
parent3765304c8564fe41a781c9288d0859734c1963d3 (diff)
downloadorg-mode-fd2a82743d674442f3c8c8e7280b3a1d65303f2f.tar.gz
contrib/lisp/org-velocity.el: Major enhancements.
This patch makes Org-Velocity display search results incrementally, and implements a more general approach to completion based on dabbrev. The documentation has also been rewritten.
-rw-r--r--contrib/lisp/org-velocity.el560
1 files changed, 355 insertions, 205 deletions
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index b3d4006..4bba504 100644
--- a/contrib/lisp/org-velocity.el
+++ b/contrib/lisp/org-velocity.el
@@ -1,10 +1,10 @@
;;; org-velocity.el --- something like Notational Velocity for Org.
-;; Copyright (C) 2010 Paul M. Rodriguez
+;; Copyright (C) 2010, 2011 Paul M. Rodriguez
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
-;; Version: 2.3
+;; Version: 2.4
;; This file is not part of GNU Emacs.
@@ -22,87 +22,121 @@
;; Suite 330, Boston, MA 02111-1307 USA
;;; Commentary:
-;; Org-Velocity.el implements an interface for Org inspired by the
-;; minimalist notetaking program Notational Velocity. The idea is to
-;; allow you to maintain, amass and access brief notes on many
-;; subjects with minimal fuss.
-
-;; It can be used in two ways: to store and access notes from any
-;; buffer a universal bucket file; or as a method for navigating any
-;; Org file.
-
-;; The name of the bucket-file (`org-velocity-bucket') and whether to
-;; always use it (`org-velocity-always-use-bucket-file') are set
-;; through Customize. If the bucket file is set but not always to be
-;; used, then calling Org-Velocity outside of Org-mode uses the bucket
-;; file; calling it in Org mode uses the current buffer. If no bucket
-;; file is set then Org-Velocity only works when called from Org.
-;; Even if the bucket file is always to be used, calling
-;; `org-velocity-read' with an argument will use the current file.
-
-;; The interface, unlike its inspiration, is not incremental.
-;; Org-Velocity prompts for search terms in the usual way; if the user
-;; has customized `org-velocity-use-completion', completion is offered
-;; on the headings in the target file. If the search multiple times
-;; in the target file, a buffer containing a buttonized list of the
-;; headings where it occurs is displayed. Results beyond what can be
-;; indexed are discarded. After clicking on a heading, or typing a
-;; character associated with it, the user is taken to the heading.
-;; (Typing 0 forces a new heading to be created.) If
-;; `org-velocity-edit-indirectly' is so set, the heading and its
-;; subtree are displayed in an indirect buffer. Otherwise the user is
-;; simply taken to the proper buffer and position.
-
-;; If the user simply hits RET at the prompt, without making a choice,
-;; then the search is restored for editing. A blank search quits.
-;; This method of selection is obviously not as slick as the original,
-;; but probably more useful for a keyboard-driven interface.
-
-;; If the search does not occur in the file the user is offered a
-;; choice to create a new heading named with the search. Org-Velocity
-;; will use `org-capture' or `org-remember' if they are loaded,
-;; preferring `org-capture'. Otherwise the user is simply taken to a
-;; new heading at the end of the file.
+;; Org-Velocity.el is an interface for Org inspired by the minimalist
+;; notetaking program Notational Velocity. The idea is to let you
+;; amass and access brief notes on many subjects with minimal fuss.
+;; Each note is an entry in an ordinary Org file.
+
+;; Org-Velocity can be used in two ways: when called outside Org, to
+;; store and access notes in a designated bucket file; or, when called
+;; inside Org, as a method for navigating any Org file. (Setting the
+;; option `org-velocity-always-use-bucket' disables navigation inside
+;; Org files by default, although you can still force this behavior by
+;; calling `org-velocity-read' with an argument.)
+
+;; Org-Velocity prompts for search terms in the minibuffer. A list of
+;; headings of entries whose text matches your search is updated as
+;; you type; you can end the search and visit an entry at any time by
+;; clicking on its heading.
+
+;; RET displays the results. If there are no matches, Org-Velocity
+;; offers to create a new entry with your search string as its
+;; heading. If there are matches, it displays a list of results where
+;; the heading of each matching entry is hinted with a number or
+;; letter; clicking a result, or typing the matching hint, opens the
+;; entry for editing in an indirect buffer. 0 forces a new entry; RET
+;; reopens the search for editing.
+
+;; You can customize every step in this process, including the search
+;; method, completion for search terms, and templates for creating new
+;; entries; M-x customize-group RET org-velocity RET to see all the
+;; options.
;; Thanks to Richard Riley, Carsten Dominik, Bastien Guerry, and Jeff
;; Horn for their suggestions.
;;; Usage:
;; (require 'org-velocity)
-;; (setq org-velocity-bucket (concat org-directory "/bucket.org"))
+;; (setq org-velocity-bucket (expand-file-name "bucket.org" org-directory))
;; (global-set-key (kbd "C-c v") 'org-velocity-read)
;;; Code:
(require 'org)
(require 'button)
(require 'electric)
+(require 'dabbrev)
(eval-when-compile (require 'cl))
(defgroup org-velocity nil
"Notational Velocity-style interface for Org."
:tag "Org-Velocity"
:group 'outlines
- :group 'hypermedia)
+ :group 'hypermedia
+ :group 'org)
(defcustom org-velocity-bucket ""
"Where is the bucket file?"
:group 'org-velocity
:type 'file)
+(defcustom org-velocity-search-is-incremental t
+ "Show results incrementally when possible?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-exit-on-match nil
+ "When searching incrementally, exit on a single match?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-force-new nil
+ "Should exiting the minibuffer with C-j force a new entry?"
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
+(defcustom org-velocity-max-depth nil
+ "Ignore headings deeper than this."
+ :group 'org-velocity
+ :type '(choice
+ (const :tag "No maximum depth" nil)
+ (integer :tag "Set maximum depth"))
+ :safe (lambda (v) (or (null v) (wholenump v))))
+
+(defcustom org-velocity-use-search-ring t
+ "Push search to `search-ring' when visiting an entry?
+
+This means that C-s C-s will take you directly to the first
+instance of the search string."
+ :group 'org-velocity
+ :type 'boolean
+ :safe 'booleanp)
+
(defcustom org-velocity-always-use-bucket nil
"Use bucket file even when called from an Org buffer?"
:group 'org-velocity
- :type 'boolean)
+ :type 'boolean
+ :safe 'booleanp)
(defcustom org-velocity-use-completion nil
- "Complete on heading names?"
+ "Use completion?
+
+Notwithstanding the value of this option, calling
+`dabbrev-expand' always completes against the text of the bucket
+file."
:group 'org-velocity
- :type 'boolean)
+ :type '(choice
+ (const :tag "Do not use completion" nil)
+ (const :tag "Use completion" t))
+ :safe 'booleanp)
(defcustom org-velocity-edit-indirectly t
"Edit entries in an indirect buffer or just visit the file?"
:group 'org-velocity
- :type 'boolean)
+ :type 'boolean
+ :safe 'booleanp)
(defcustom org-velocity-search-method 'phrase
"Match on whole phrase, any word, or all words?"
@@ -110,7 +144,9 @@
:type '(choice
(const :tag "Match whole phrase" phrase)
(const :tag "Match any word" any)
- (const :tag "Match all words" all)))
+ (const :tag "Match all words" all)
+ (const :tag "Match a regular expression" regexp))
+ :safe (lambda (v) (memq v '(phrase any all regexp))))
(defcustom org-velocity-create-method 'capture
"Prefer `org-capture', `org-remember', or neither?"
@@ -118,12 +154,8 @@
:type '(choice
(const :tag "Prefer capture > remember > default." capture)
(const :tag "Prefer remember > default." remember)
- (const :tag "Edit in buffer." buffer)))
-
-(defcustom org-velocity-allow-regexps nil
- "Allow searches to use regular expressions?"
- :group 'org-velocity
- :type 'boolean)
+ (const :tag "Edit in buffer." buffer))
+ :safe (lambda (v) (memq v '(capture remember buffer))))
(defcustom org-velocity-remember-templates
'(("Velocity entry"
@@ -152,17 +184,18 @@ See the documentation for `org-capture-templates'."
:type (or (get 'org-capture-templates 'custom-type) 'list))
(defstruct (org-velocity-heading
- (:constructor org-velocity-make-heading)
+ (:constructor org-velocity-make-heading
+ (&aux (components (org-heading-components))))
(:type list))
(marker (point-marker))
- (name (substring-no-properties
- (org-get-heading))))
+ (name (nth 4 components))
+ (level (nth 0 components)))
(defconst org-velocity-index
(eval-when-compile
- (nconc (number-sequence 49 57) ;numbers
- (number-sequence 97 122) ;lowercase letters
- (number-sequence 65 90))) ;uppercase letters
+ (nconc (number-sequence 49 57) ;numbers
+ (number-sequence 97 122) ;lowercase letters
+ (number-sequence 65 90))) ;uppercase letters
"List of chars for indexing results.")
(defconst org-velocity-display-buffer-name "*Velocity headings*")
@@ -172,24 +205,40 @@ See the documentation for `org-capture-templates'."
(defsubst org-velocity-buffer-file-name (&optional buffer)
"Return the name of the file BUFFER saves to.
-Same as function `buffer-file-name' unless BUFFER is an
-indirect buffer."
- (buffer-file-name
- (or (buffer-base-buffer buffer)
- buffer)))
+Same as function `buffer-file-name' unless BUFFER is an indirect
+buffer or a minibuffer. In the former case, return the file name
+of the base buffer; in the latter, return the file name of
+`minibuffer-selected-window' (or its base buffer)."
+ (let ((buffer (if (minibufferp buffer)
+ (window-buffer (minibuffer-selected-window))
+ buffer)))
+ (buffer-file-name
+ (or (buffer-base-buffer buffer)
+ buffer))))
+
+(defun org-velocity-minibuffer-contents ()
+ "Return the contents of the minibuffer when it is active."
+ (if (active-minibuffer-window)
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (minibuffer-contents))))
(defun org-velocity-use-file ()
"Return the proper file for Org-Velocity to search.
If `org-velocity-always-use-bucket' is t, use bucket file; complain
if missing. Otherwise if this is an Org file, use it."
(or
- ;; In remember and capture buffers the target should be used.
- (and org-remember-mode org-default-notes-file)
+ ;; Use the target in in remember buffers.
+ (if (and (boundp 'org-remember-mode) org-remember-mode)
+ org-default-notes-file)
(let ((org-velocity-bucket
- (and org-velocity-bucket (expand-file-name org-velocity-bucket))))
+ (and org-velocity-bucket (expand-file-name org-velocity-bucket)))
+ (buffer (if (org-velocity-buffer-file-name)
+ ;; Use the target in capture buffers.
+ (org-find-base-buffer-visiting (org-velocity-buffer-file-name)))))
(if org-velocity-always-use-bucket
- (or org-velocity-bucket (error "Bucket required but not defined"))
- (if (and (eq major-mode 'org-mode)
+ (or org-velocity-bucket (error "Bucket required but not defined"))
+ (if (and (eq (buffer-local-value 'major-mode (or buffer (current-buffer)))
+ 'org-mode)
(org-velocity-buffer-file-name))
(org-velocity-buffer-file-name)
(or org-velocity-bucket
@@ -203,50 +252,60 @@ if missing. Otherwise if this is an Org file, use it."
"Return proper buffer for bucket operations."
(find-file-noselect (org-velocity-use-file)))
-(defun org-velocity-quote (search)
- "Quote SEARCH as a regexp if `org-velocity-allow-regexps' is non-nil.
-Acts like `regexp-quote' on a string, `regexp-opt' on a list."
- (if org-velocity-allow-regexps
- search
- (if (listp search)
- (regexp-opt search)
- (regexp-quote search))))
-
(defun org-velocity-nearest-heading (position)
"Return last heading at POSITION.
If there is no last heading, return nil."
(save-excursion
(goto-char position)
- (unless (org-before-first-heading-p)
- (org-back-to-heading)
- (org-velocity-make-heading))))
+ ;; If we are before the first heading we could still be at the
+ ;; first heading.
+ (unless (and (org-before-first-heading-p)
+ (not (org-at-heading-p)))
+ (org-back-to-heading t)
+ (let ((heading (org-velocity-make-heading)))
+ (if org-velocity-max-depth
+ (if (<= (org-velocity-heading-level heading)
+ org-velocity-max-depth)
+ heading)
+ heading)))))
(defun org-velocity-make-button-action (heading)
"Return a form to visit HEADING."
`(lambda (button)
- (run-hooks 'mouse-leave-buffer-hook) ;turn off temporary modes
- (if org-velocity-edit-indirectly
- (org-velocity-edit-entry ',heading)
- (progn
- (message "%s" ,(org-velocity-heading-name heading))
- (switch-to-buffer (marker-buffer
- ,(org-velocity-heading-marker heading)))
- (goto-char (marker-position
- ,(org-velocity-heading-marker heading)))))))
+ (run-hooks 'mouse-leave-buffer-hook) ;turn off temporary modes
+ (if org-velocity-use-search-ring
+ (add-to-history 'search-ring ,org-velocity-search search-ring-max))
+ (if org-velocity-edit-indirectly
+ (org-velocity-edit-entry ',heading)
+ (progn
+ (message "%s" ,(org-velocity-heading-name heading))
+ (switch-to-buffer (marker-buffer
+ ,(org-velocity-heading-marker heading)))
+ (goto-char (marker-position
+ ,(org-velocity-heading-marker heading)))))))
+
+(defun org-velocity-make-indirect-buffer (heading)
+ "Make or switch to an indirect buffer visiting HEADING."
+ (let* ((bucket (marker-buffer (org-velocity-heading-marker heading)))
+ (name (org-velocity-heading-name heading))
+ (existing (get-buffer name)))
+ (if (and existing (buffer-base-buffer existing)
+ (equal (buffer-base-buffer existing) bucket))
+ existing
+ (make-indirect-buffer
+ bucket
+ (generate-new-buffer-name (org-velocity-heading-name heading))))))
(defun org-velocity-edit-entry (heading)
"Edit entry at HEADING in an indirect buffer."
- (let ((buffer (make-indirect-buffer
- (marker-buffer (org-velocity-heading-marker heading))
- (generate-new-buffer-name
- (org-velocity-heading-name heading)))))
+ (let ((buffer (org-velocity-make-indirect-buffer heading)))
(with-current-buffer buffer
(let ((org-inhibit-startup t))
(org-mode))
(goto-char (marker-position (org-velocity-heading-marker heading)))
(narrow-to-region (point)
(save-excursion
- (org-end-of-subtree)
+ (org-end-of-subtree t)
(point)))
(goto-char (point-min))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
@@ -264,146 +323,149 @@ If there is no last heading, return nil."
(save-buffer)
(kill-buffer)))
+(defun org-velocity-buttonize-no-hints (heading)
+ "Insert HEADING as a text button with no hints."
+ (let ((action (org-velocity-make-button-action heading)))
+ (insert-text-button
+ (org-velocity-heading-name heading)
+ 'action action))
+ (newline))
+
(defun org-velocity-buttonize (heading)
- "Insert HEADING as a text button."
+ "Insert HEADING as a text button with an hint."
(insert (format "#%c " (nth (1- (line-number-at-pos))
org-velocity-index)))
- (let ((action (org-velocity-make-button-action heading)))
- (insert-text-button
- (org-velocity-heading-name heading)
- 'action action))
- (newline))
+ (org-velocity-buttonize-no-hints heading))
(defun org-velocity-remember ()
"Use `org-remember' to record a note."
(let ((org-remember-templates
org-velocity-remember-templates))
- (call-interactively 'org-remember)))
+ (call-interactively 'org-remember)
+ (when org-remember-mode
+ (set (make-local-variable 'remember-buffer)
+ (rename-buffer org-velocity-search t)))))
(defun org-velocity-capture ()
"Use `org-capture' to record a note."
(let ((org-capture-templates
org-velocity-capture-templates))
- (if (fboundp 'org-capture) ;; quiet compiler
- (call-interactively 'org-capture))))
-
-(defun org-velocity-insert-heading (heading)
- "Add a new heading named HEADING."
- (with-current-buffer (org-velocity-bucket-buffer)
+ (when (fboundp 'org-capture) ;; quiet compiler
+ (call-interactively 'org-capture)
+ (if org-capture-mode (rename-buffer org-velocity-search t)))))
+
+(defun org-velocity-insert-heading (&optional heading)
+ "Add a new heading named HEADING and go to it."
+ (let ((heading (or heading org-velocity-search)))
+ (pop-to-buffer (org-velocity-bucket-buffer))
(goto-char (point-max))
- (newline)
- (org-insert-heading) (insert heading)
- (newline)
- (goto-char (point-max))))
-
-(defun org-velocity-create-heading ()
- "Add and visit a new heading."
- (org-store-link nil)
- (destructuring-bind (&key search initial
- &allow-other-keys)
- org-store-link-plist
- (org-velocity-insert-heading search)
- (switch-to-buffer (org-velocity-bucket-buffer))
- (insert (or initial ""))))
-
-(defun org-velocity-all-search (search)
- "Return entries containing all words in SEARCH."
- (when (file-exists-p (org-velocity-use-file))
- (save-excursion
- (delq nil
- (let ((keywords
- (mapcar 'org-velocity-quote
- (split-string search)))
- (case-fold-search t))
- (org-map-entries
- (lambda ()
- (if (loop with limit = (save-excursion
- (org-end-of-subtree)
- (point))
- for word in keywords
- always (save-excursion
- (re-search-forward word limit t)))
- (org-velocity-nearest-heading
- (match-beginning 0))))))))))
+ (let ((inhibit-quit t))
+ (newline)
+ (org-insert-heading t t) (insert heading)
+ (newline)
+ (goto-char (point-max)))))
(defun org-velocity-generic-search (search)
"Return entries containing SEARCH."
(save-excursion
- (delq nil
- (nreverse
- (let (matches (case-fold-search t))
- (goto-char (point-min))
- (while (re-search-forward search
- (point-max) t)
- (push (org-velocity-nearest-heading (match-beginning 0))
- matches)
- (outline-next-heading))
- matches)))))
+ (loop initially (goto-char (point-min))
+ while (re-search-forward search (point-max) t)
+ if (org-velocity-nearest-heading (match-beginning 0))
+ collect it
+ do (outline-next-heading))))
(defsubst org-velocity-phrase-search (search)
"Return entries containing SEARCH as a phrase."
- (org-velocity-generic-search (org-velocity-quote search)))
+ (org-velocity-generic-search (regexp-quote search)))
(defsubst org-velocity-any-search (search)
"Return entries containing any word in SEARCH."
- (org-velocity-generic-search (org-velocity-quote (split-string search))))
+ (org-velocity-generic-search (regexp-opt (split-string search))))
+
+(defsubst org-velocity-regexp-search (search)
+ (condition-case lossage
+ (org-velocity-generic-search search)
+ (invalid-regexp (minibuffer-message "%s" lossage))))
-(defun org-velocity-present (headings)
- "Buttonize HEADINGS in `org-velocity-display-buffer'."
+(defun org-velocity-all-search (search)
+ "Return entries containing all words in SEARCH."
+ (save-excursion
+ (let ((keywords (mapcar 'regexp-quote (split-string search))))
+ (delq nil
+ (org-map-entries
+ (lambda ()
+ ;; Only search the subtree once.
+ (setq org-map-continue-from
+ (save-excursion (org-end-of-subtree t) (point)))
+ (if (loop for word in keywords
+ always (save-excursion
+ (re-search-forward
+ word org-map-continue-from t)))
+ (org-velocity-nearest-heading (point)))))))))
+
+(defun org-velocity-present (headings &optional no-hints search)
+ "Buttonize HEADINGS in `org-velocity-display-buffer'.
+If NO-HINTS is non-nil, display entries without indices.
+SEARCH binds `org-velocity-search'."
(and (listp headings) (delete-dups headings))
(let ((cdr (nthcdr
(1- (length org-velocity-index))
headings)))
(and (consp cdr) (setcdr cdr nil)))
- (with-current-buffer (org-velocity-display-buffer)
- (mapc
- 'org-velocity-buttonize
- headings)
- (goto-char (point-min))))
+ (let ((org-velocity-search search))
+ (with-current-buffer (org-velocity-display-buffer)
+ (mapc
+ (if no-hints 'org-velocity-buttonize-no-hints
+ 'org-velocity-buttonize)
+ headings)
+ (goto-char (point-min)))))
(defun org-velocity-create-1 ()
"Create a new heading.
The possible methods are `org-velocity-capture',
-`org-velocity-remember', or `org-velocity-create-heading', in
+`org-velocity-remember', or `org-velocity-create', in
that order. Which is preferred is determined by
`org-velocity-create-method'."
(funcall
(ecase org-velocity-create-method
(capture (or (and (featurep 'org-capture) 'org-velocity-capture)
(and (featurep 'org-remember) 'org-velocity-remember)
- 'org-velocity-create-heading))
+ 'org-velocity-insert-heading))
(remember (or (and (featurep 'org-remember) 'org-velocity-remember)
- 'org-velocity-create-heading))
- (buffer 'org-velocity-create-heading))))
+ 'org-velocity-insert-heading))
+ (buffer 'org-velocity-insert-heading))))
(defun org-velocity-store-link ()
"Function for `org-store-link-functions'."
(if org-velocity-search
- (org-store-link-props
- :search org-velocity-search)))
+ (org-store-link-props
+ :search org-velocity-search)))
(add-hook 'org-store-link-functions 'org-velocity-store-link)
(defun org-velocity-create (search &optional ask)
"Create new heading named SEARCH.
If ASK is non-nil, ask first."
- (when (or (null ask)
- (y-or-n-p "No match found, create? "))
+ (when (or (null ask) (y-or-n-p "No match found, create? "))
(let ((org-velocity-search search)
(org-default-notes-file (org-velocity-use-file))
;; save a stored link
- (org-store-link-plist))
+ org-store-link-plist)
(org-velocity-create-1))
search))
(defun org-velocity-get-matches (search)
"Return matches for SEARCH in current bucket.
Use method specified by `org-velocity-search-method'."
- (with-current-buffer (org-velocity-bucket-buffer)
- (case org-velocity-search-method
- ('phrase (org-velocity-phrase-search search))
- ('any (org-velocity-any-search search))
- ('all (org-velocity-all-search search)))))
+ (when (and search (not (string-equal "" search)))
+ (with-current-buffer (org-velocity-bucket-buffer)
+ ;; Fold case if the search string is lowercase.
+ (let ((case-fold-search (equal search (downcase search))))
+ (case org-velocity-search-method
+ ('phrase (org-velocity-phrase-search search))
+ ('any (org-velocity-any-search search))
+ ('all (org-velocity-all-search search))
+ ('regexp (org-velocity-regexp-search search)))))))
(defun org-velocity-engine (search)
"Display a list of headings where SEARCH occurs."
@@ -414,23 +476,26 @@ Use method specified by `org-velocity-search-method'."
(not (stringp search))
(string-equal "" search)) ;exit on empty string
(case
- (with-current-buffer (org-velocity-bucket-buffer)
- (save-excursion
- (let ((matches (org-velocity-get-matches search)))
- (org-velocity-present matches)
- (cond ((zerop (length matches)) 'new)
- ((= (length matches) 1) 'follow)
- ((> (length matches) 1) 'prompt)))))
+ (if (and org-velocity-force-new (eq last-command-event ?\C-j))
+ 'force
+ (with-current-buffer (org-velocity-bucket-buffer)
+ (save-excursion
+ (let ((matches (org-velocity-get-matches search)))
+ (org-velocity-present matches nil search)
+ (cond ((zerop (length matches)) 'new)
+ ((= (length matches) 1) 'follow)
+ ((> (length matches) 1) 'prompt))))))
('prompt (progn
(Electric-pop-up-window (org-velocity-display-buffer))
(let ((hint (org-velocity-electric-follow-hint)))
(if hint
(case hint
(edit (org-velocity-read nil search))
- (new (org-velocity-create search))
+ (force (org-velocity-create search))
(otherwise (org-velocity-activate-button hint)))))))
('new (unless (org-velocity-create search t)
(org-velocity-read nil search)))
+ ('force (org-velocity-create search))
('follow (if (y-or-n-p "One match, follow? ")
(progn
(set-buffer (org-velocity-display-buffer))
@@ -467,7 +532,7 @@ Use method specified by `org-velocity-search-method'."
"Follow a hint indexed by keyboard event EV."
(interactive (list last-command-event))
(if (not (> (org-velocity-position ev org-velocity-index)
- (1- (count-lines (point-min) (point-max)))))
+ (1- (count-lines (point-min) (point-max)))))
(throw 'org-velocity-select ev)
(call-interactively 'org-velocity-electric-undefined)))
@@ -488,11 +553,12 @@ Use method specified by `org-velocity-search-method'."
(defun org-velocity-electric-new ()
"Force a new entry."
(interactive)
- (throw 'org-velocity-select 'new))
+ (throw 'org-velocity-select 'force))
(defvar org-velocity-electric-map
(let ((map (make-sparse-keymap)))
- (define-key map [t] 'org-velocity-electric-undefined) (loop for c in org-velocity-index
+ (define-key map [t] 'org-velocity-electric-undefined)
+ (loop for c in org-velocity-index
do (define-key map (char-to-string c) 'org-velocity-electric-follow))
(define-key map "0" 'org-velocity-electric-new)
(define-key map [tab] 'scroll-up)
@@ -511,15 +577,76 @@ Use method specified by `org-velocity-search-method'."
(Electric-command-loop 'org-velocity-select
"Follow: "))))
+(defvar org-velocity-incremental-keymap
+ (let ((map (make-sparse-keymap)))
+ (define-key map [mouse-1] 'org-velocity-click-for-incremental)
+ (define-key map [mouse-2] 'org-velocity-click-for-incremental)
+ map))
+
+(defun org-velocity-click-for-incremental ()
+ "Jump out of search and select hint clicked on."
+ (interactive)
+ (let ((ev last-command-event))
+ (org-velocity-activate-button
+ (nth (- (count-lines
+ (point-min)
+ (posn-point (event-start ev))) 2)
+ org-velocity-index)))
+ (throw 'click (current-buffer)))
+
+(defun org-velocity-displaying-completions-p ()
+ "Is there a *Completions* buffer showing?"
+ (get-window-with-predicate
+ (lambda (w)
+ (eq (buffer-local-value 'major-mode (window-buffer w))
+ 'completion-list-mode))))
+
+(defun org-velocity-display-for-incremental ()
+ "Display results of search without hinting."
+ (when (and (sit-for idle-update-delay)
+ (not (org-velocity-displaying-completions-p)))
+ (let* ((search (org-velocity-minibuffer-contents))
+ (matches (org-velocity-get-matches search)))
+ (if (zerop (length matches))
+ (progn
+ (when (get-buffer-window (org-velocity-display-buffer))
+ (delete-window
+ (get-buffer-window (org-velocity-display-buffer)))
+ (select-window (active-minibuffer-window)))
+ (unless (string-equal search "")
+ (minibuffer-message "No match; RET to create")))
+ (if (and org-velocity-exit-on-match
+ (= (length matches) 1))
+ (throw 'click search))
+ (with-current-buffer (org-velocity-display-buffer)
+ (use-local-map org-velocity-incremental-keymap)
+ (erase-buffer)
+ (setq cursor-type nil))
+ (with-current-buffer (org-velocity-bucket-buffer)
+ (org-velocity-present matches t search))
+ (display-buffer (org-velocity-display-buffer))))))
+
+(defun org-velocity-dabbrev-completion-list (abbrev)
+ "Return all dabbrev completions for ABBREV."
+ ;; This is based on `dabbrev-completion'.
+ (dabbrev--reset-global-variables)
+ (setq dabbrev--last-abbrev abbrev)
+ (dabbrev--find-all-expansions abbrev case-fold-search))
+
(defun org-velocity-read-with-completion (prompt)
- "Like `completing-read' on entries with PROMPT.
-Use `minibuffer-local-filename-completion-map'."
+ "Completing read with PROMPT."
(let ((minibuffer-local-completion-map
- minibuffer-local-filename-completion-map))
- (completing-read
+ minibuffer-local-filename-completion-map)
+ (completion-no-auto-exit t)
+ (crm-separator " "))
+ (funcall
+ (case org-velocity-search-method
+ (phrase 'completing-read)
+ (any 'completing-read-multiple)
+ (all 'completing-read-multiple))
prompt
- (mapcar 'substring-no-properties
- (org-map-entries 'org-get-heading)))))
+ (completion-table-dynamic
+ 'org-velocity-dabbrev-completion-list))))
(defun org-velocity-read-string (prompt &optional initial-input)
"Read string with PROMPT followed by INITIAL-INPUT."
@@ -528,14 +655,33 @@ Use `minibuffer-local-filename-completion-map'."
;; thing to do.
(minibuffer-with-setup-hook
(lexical-let ((initial-input initial-input))
- (lambda ()
- (and initial-input (insert initial-input))
- (goto-char (point-max))))
- (if (and org-velocity-use-completion
- ;; map-entries complains for nonexistent files
- (file-exists-p (org-velocity-use-file)))
- (org-velocity-read-with-completion prompt)
- (read-string prompt))))
+ (lambda ()
+ (and initial-input (insert initial-input))
+ (goto-char (point-max))))
+ (if (eq org-velocity-search-method 'regexp)
+ (read-regexp prompt)
+ (if (and org-velocity-use-completion
+ ;; map-entries complains for nonexistent files
+ (file-exists-p (org-velocity-use-file)))
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt)))))
+
+(defun org-velocity-read-incrementally (prompt)
+ "Read string with PROMPT and display results incrementally."
+ (let ((res
+ (unwind-protect
+ (catch 'click
+ (add-hook 'post-command-hook
+ 'org-velocity-display-for-incremental)
+ (if (eq org-velocity-search-method 'regexp)
+ (read-regexp prompt)
+ (if (and org-velocity-use-completion
+ (file-exists-p (org-velocity-use-file)))
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt))))
+ (remove-hook 'post-command-hook
+ 'org-velocity-display-for-incremental))))
+ (if (bufferp res) (switch-to-buffer res) res)))
(defun org-velocity-read (arg &optional search)
"Read a search string SEARCH for Org-Velocity interface.
@@ -554,8 +700,12 @@ file. Calling with ARG forces current file."
;; complain if inappropriate
(assert (org-velocity-use-file))
(unwind-protect
- (org-velocity-engine
- (org-velocity-read-string "Velocity search: " search))
+ (let ((dabbrev-search-these-buffers-only
+ (list (org-velocity-bucket-buffer))))
+ (org-velocity-engine
+ (if org-velocity-search-is-incremental
+ (org-velocity-read-incrementally "Velocity search: ")
+ (org-velocity-read-string "Velocity search: " search))))
(progn
(kill-buffer (org-velocity-display-buffer))
(delete-other-windows)))))