Rewrite of contrib/lisp/org-velocity.el.

From the author: "This is a rewrite of Org-Velocity for speed. Delays due
to file size should no longer be perceptible. I have also added in-line
previews of entry contents and dropped support for Org-Remember."

contrib/lisp/org-velocity.el

@@ -4,7 +4,7 @@
 
 ;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
 ;; Created: 2010-05-05
-;; Version: 2.4
+;; Version: 3.0
 
 ;; This file is not part of GNU Emacs.
 
@@ -58,7 +58,7 @@
 ;;; Usage:
 ;; (require 'org-velocity)
 ;; (setq org-velocity-bucket (expand-file-name "bucket.org" org-directory))
-;; (global-set-key (kbd "C-c v") 'org-velocity-read)
+;; (global-set-key (kbd "C-c v") 'org-velocity)
 
 ;;; Code:
 (require 'org)
@@ -85,6 +85,12 @@
   :type 'boolean
   :safe 'booleanp)
 
+(defcustom org-velocity-show-previews t
+  "Show previews of the text of each heading?"
+  :group 'velocity
+  :type 'boolean
+  :safe 'booleanp)
+
 (defcustom org-velocity-exit-on-match nil
   "When searching incrementally, exit on a single match?"
   :group 'org-velocity
@@ -97,14 +103,6 @@
   :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?
 
@@ -132,12 +130,6 @@ file."
           (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
-  :safe 'booleanp)
-
 (defcustom org-velocity-search-method 'phrase
   "Match on whole phrase, any word, or all words?"
   :group 'org-velocity
@@ -148,28 +140,6 @@ file."
           (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?"
-  :group 'org-velocity
-  :type '(choice
-	  (const :tag "Prefer capture > remember > default." capture)
-	  (const :tag "Prefer remember > default." remember)
-	  (const :tag "Edit in buffer." buffer))
-  :safe (lambda (v) (memq v '(capture remember buffer))))
-
-(defcustom org-velocity-remember-templates
-  '(("Velocity entry"
-     ?v
-     "* %:search\n\n%i%?"
-     nil
-     bottom))
-  "Use these templates with `org-remember'.
-Meanwhile `org-default-notes-file' is bound to `org-velocity-use-file'.
-The keyword :search inserts the current search.
-See the documentation for `org-remember-templates'."
-  :group 'org-velocity
-  :type (or (get 'org-remember-templates 'custom-type) 'list))
-
 (defcustom org-velocity-capture-templates
   '(("v"
      "Velocity entry"
@@ -177,19 +147,48 @@ See the documentation for `org-remember-templates'."
      (file "")
      "* %:search\n\n%i%?"))
   "Use these template with `org-capture'.
-Meanwhile `org-default-notes-file' is bound to `org-velocity-use-file'.
+Meanwhile `org-default-notes-file' is bound to `org-velocity-bucket-file'.
 The keyword :search inserts the current search.
 See the documentation for `org-capture-templates'."
   :group 'org-velocity
   :type (or (get 'org-capture-templates 'custom-type) 'list))
 
-(defstruct (org-velocity-heading
-	    (:constructor org-velocity-make-heading
-                          (&aux (components (org-heading-components))))
-	    (:type list))
-  (marker (point-marker))
-  (name (nth 4 components))
-  (level (nth 0 components)))
+(defsubst org-velocity-grab-preview ()
+  "Grab preview of a subtree.
+The length of the preview is determined by `window-width'.
+
+Replace all contiguous whitespace with single spaces."
+  (let ((start (progn
+                 (forward-line 1)
+                 (if (looking-at org-property-start-re)
+                     (re-search-forward org-property-end-re)
+                   (1- (point))))))
+    (mapconcat
+     #'identity
+     (split-string
+      (buffer-substring-no-properties
+       start
+       (min
+        (+ start (window-width))
+        (point-max))))
+     " ")))
+
+(defstruct org-velocity-heading buffer position name level preview)
+
+(defsubst org-velocity-nearest-heading (position)
+  "Return last heading at POSITION.
+If there is no last heading, return nil."
+  (save-excursion
+    (goto-char position)
+    (re-search-backward org-velocity-heading-regexp)
+    (let ((components (org-heading-components)))
+      (make-org-velocity-heading
+       :buffer (current-buffer)
+       :position (point)
+       :name (nth 4 components)
+       :level (nth 0 components)
+       :preview (if org-velocity-show-previews
+                    (org-velocity-grab-preview))))))
 
 (defconst org-velocity-index
   (eval-when-compile
@@ -198,15 +197,18 @@ See the documentation for `org-capture-templates'."
            (number-sequence 65 90)))	;uppercase letters
   "List of chars for indexing results.")
 
-(defconst org-velocity-display-buffer-name "*Velocity headings*")
+(defconst org-velocity-match-buffer-name "*Velocity matches*")
+
+(defconst org-velocity-heading-regexp "^\\* "
+  "Regexp to match only top-level headings.")
 
 (defvar org-velocity-search nil
   "Variable to bind to current search.")
 
-(defsubst org-velocity-buffer-file-name (&optional buffer)
+(defun 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 or a minibuffer.  In the former case, return the file name
+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)
@@ -222,71 +224,55 @@ of the base buffer; in the latter, return the file name of
       (with-current-buffer (window-buffer (active-minibuffer-window))
         (minibuffer-contents))))
 
-(defun org-velocity-use-file ()
+(defsubst org-velocity-singlep (object)
+  "Return t when OBJECT is a list or sequence of one element."
+  (if (consp object)
+      (null (cdr object))
+    (= (length object) 1)))
+
+(defun org-velocity-bucket-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
-   ;; 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)))
-         (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 (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
-	     (error "No bucket and not an Org file")))))))
-
-(defsubst org-velocity-display-buffer ()
-  "Return the proper buffer for Org-Velocity to display in."
-  (get-buffer-create org-velocity-display-buffer-name))
+If `org-velocity-always-use-bucket' is t, use bucket file;
+complain if missing. Otherwise, if an Org file is current, then
+use it."
+  (let ((org-velocity-bucket
+         (when org-velocity-bucket (expand-file-name org-velocity-bucket)))
+        (buffer
+         (let ((buffer-file (org-velocity-buffer-file-name)))
+           (when buffer-file
+             ;; Use the target in capture buffers.
+             (org-find-base-buffer-visiting buffer-file)))))
+    (if org-velocity-always-use-bucket
+        (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
+            (error "No bucket and not an Org file"))))))
+
+(defvar org-velocity-bucket-buffer nil)
 
 (defsubst org-velocity-bucket-buffer ()
-  "Return proper buffer for bucket operations."
-  (find-file-noselect (org-velocity-use-file)))
+  (or org-velocity-bucket-buffer
+      (find-file-noselect (org-velocity-bucket-file))))
 
-(defun org-velocity-nearest-heading (position)
-  "Return last heading at POSITION.
-If there is no last heading, return nil."
-  (save-excursion
-    (goto-char position)
-    ;; 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-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))
-         (org-pop-to-buffer-same-window (marker-buffer
-                            ,(org-velocity-heading-marker heading)))
-         (goto-char (marker-position
-                     ,(org-velocity-heading-marker heading)))))))
+(defsubst org-velocity-match-buffer ()
+  "Return the proper buffer for Org-Velocity to display in."
+  (get-buffer-create org-velocity-match-buffer-name))
+
+(defun org-velocity-beginning-of-headings ()
+  "Goto the start of the first heading."
+  (goto-char (point-min))
+  ;; If we are before the first heading we could still be at the
+  ;; first heading.
+  (or (looking-at org-velocity-heading-regexp)
+      (re-search-forward org-velocity-heading-regexp)))
 
 (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)))
+
+  (let* ((bucket (org-velocity-heading-buffer heading))
          (name (org-velocity-heading-name heading))
          (existing (get-buffer name)))
     (if (and existing (buffer-base-buffer existing)
@@ -296,144 +282,168 @@ If there is no last heading, return nil."
        bucket
        (generate-new-buffer-name (org-velocity-heading-name heading))))))
 
+(defun org-velocity-capture ()
+  "Record a note with `org-capture'."
+  (let ((org-capture-templates
+         org-velocity-capture-templates))
+    (org-capture nil
+                 ;; This is no longer automatically selected.
+                 (when (org-velocity-singlep org-capture-templates)
+                   (caar org-capture-templates)))
+    (if org-capture-mode (rename-buffer org-velocity-search t))))
+
+(defvar org-velocity-saved-winconf nil)
+(make-variable-buffer-local 'org-velocity-saved-winconf)
+
 (defun org-velocity-edit-entry (heading)
   "Edit entry at HEADING in an indirect buffer."
-  (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 t)
-			  (point)))
-      (goto-char (point-min))
-      (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
-    (pop-to-buffer buffer)
-    (set (make-local-variable 'header-line-format)
-	 (format "%s Use C-c C-c to finish."
-		 (abbreviate-file-name
-		  (buffer-file-name
-		   (marker-buffer
-		    (org-velocity-heading-marker heading))))))))
+  (let ((winconf (current-window-configuration)))
+    (let ((buffer (org-velocity-make-indirect-buffer heading)))
+      (with-current-buffer buffer
+        (let ((org-inhibit-startup t))
+          (org-mode))
+        (setq org-velocity-saved-winconf winconf)
+        (goto-char (org-velocity-heading-position heading))
+        (narrow-to-region (point)
+                          (save-excursion
+                            (org-end-of-subtree t)
+                            (point)))
+        (goto-char (point-min))
+        (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
+      (pop-to-buffer buffer)
+      (set (make-local-variable 'header-line-format)
+           (format "%s Use C-c C-c to finish."
+                   (abbreviate-file-name
+                    (buffer-file-name
+                     (org-velocity-heading-buffer heading))))))))
 
 (defun org-velocity-dismiss ()
   "Save current entry and close indirect buffer."
-  (progn
-    (save-buffer)
-    (kill-buffer)))
-
-(defun org-velocity-buttonize-no-hints (heading)
+  (let ((winconf org-velocity-saved-winconf))
+    (prog1 t                            ;Tell hook we're done.
+      (save-buffer)
+      (kill-buffer)
+      (when (window-configuration-p winconf)
+        (set-window-configuration winconf)))))
+
+(defun org-velocity-visit-button (button)
+  (run-hooks 'mouse-leave-buffer-hook)
+  (if org-velocity-use-search-ring
+      (add-to-history 'search-ring
+                      (button-get button 'search)
+                      search-ring-max))
+  (org-velocity-edit-entry (button-get button 'match)))
+
+(define-button-type 'org-velocity-button
+  'action #'org-velocity-visit-button)
+
+(defsubst org-velocity-buttonize (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 with an hint."
-  (insert (format "#%c " (nth (1- (line-number-at-pos))
-			      org-velocity-index)))
-  (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)
-    (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))
-    (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))
-    (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
-    (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 (regexp-quote search)))
-
-(defsubst org-velocity-any-search (search)
-  "Return entries containing any word in 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-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)))
-  (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', 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-insert-heading))
-     (remember (or (and (featurep 'org-remember) 'org-velocity-remember)
-		   'org-velocity-insert-heading))
-     (buffer 'org-velocity-insert-heading))))
+  (insert-text-button
+   (propertize (org-velocity-heading-name heading) 'face 'link)
+   :type 'org-velocity-button
+   'match heading
+   'search org-velocity-search))
+
+(defsubst org-velocity-insert-preview (heading)
+  (when org-velocity-show-previews
+    (insert-char ?\  1)
+    (insert
+     (propertize
+      (org-velocity-heading-preview heading)
+      'face 'shadow))))
+
+(defsubst* org-velocity-present-match (&key hint match)
+  (with-current-buffer (org-velocity-match-buffer)
+    (when hint (insert "#" hint " "))
+    (org-velocity-buttonize match)
+    (org-velocity-insert-preview match)
+    (newline)))
+
+(defun org-velocity-generic-search (search &optional hide-hints)
+  "Display any entry containing SEARCH."
+  (let ((hints org-velocity-index) matches)
+    (block nil
+      (while (and hints (re-search-forward search nil t))
+        (let ((match (org-velocity-nearest-heading (point))))
+          (org-velocity-present-match
+           :hint (unless hide-hints (car hints))
+           :match match)
+          (push match matches))
+        (setq hints (cdr hints))
+        (unless (re-search-forward org-velocity-heading-regexp nil t)
+          (return))))
+    (nreverse matches)))
+
+(defun* org-velocity-all-search (search &optional hide-hints max)
+  "Display only entries containing every word in SEARCH."
+  (let ((keywords (mapcar 'regexp-quote (split-string search)))
+        (hints org-velocity-index)
+        matches)
+    (org-map-entries
+     (lambda ()
+       ;; Return if we've run out of hints.
+       (when (null hints)
+         (return-from org-velocity-all-search (nreverse matches)))
+       ;; Only search the subtree once.
+       (setq org-map-continue-from
+             (save-excursion
+               (goto-char (line-end-position))
+               (if (re-search-forward org-velocity-heading-regexp nil t)
+                   (line-end-position)
+                 (point-max))))
+       (when (loop for word in keywords
+                   always (save-excursion
+                            (re-search-forward
+                             (concat "\\<" word "\\>")
+                             org-map-continue-from t)))
+         (let ((match (org-velocity-nearest-heading (match-end 0))))
+           (org-velocity-present-match
+            :hint (unless hide-hints (car hints))
+            :match match)
+           (push match matches)
+           (setq hints (cdr hints))))))
+    (nreverse matches)))
+
+(defun* org-velocity-present (search &key hide-hints)
+  "Buttonize matches for SEARCH in `org-velocity-match-buffer'.
+If HIDE-HINTS is non-nil, display entries without indices. SEARCH
+binds `org-velocity-search'.
+
+Return matches."
+  (if (and (stringp search) (not (string= "" search)))
+      ;; Fold case when the search string is all lowercase.
+      (let ((case-fold-search (equal search (downcase search)))
+            (truncate-partial-width-windows t))
+        (with-current-buffer (org-velocity-match-buffer)
+          (erase-buffer)
+          ;; Permanent locals.
+          (setq cursor-type nil
+                truncate-lines t))
+        (prog1
+            (with-current-buffer (org-velocity-bucket-buffer)
+              (let ((inhibit-point-motion-hooks t)
+                    (inhibit-field-text-motion t))
+                (save-excursion
+                  (org-velocity-beginning-of-headings)
+                  (case org-velocity-search-method
+                    (all (org-velocity-all-search search hide-hints))
+                    (phrase (org-velocity-generic-search
+                             (concat "\\<" (regexp-quote search))
+                             hide-hints))
+                    (any (org-velocity-generic-search
+                          (concat "\\<"
+                                  (regexp-opt (split-string search)))
+                          hide-hints))
+                    (regexp (condition-case lossage
+                                (org-velocity-generic-search
+                                 search hide-hints)
+                              (invalid-regexp
+                               (minibuffer-message "%s" lossage))))))))
+          (with-current-buffer (org-velocity-match-buffer)
+            (goto-char (point-min)))))
+    (with-current-buffer (org-velocity-match-buffer)
+      (erase-buffer))))
 
 (defun org-velocity-store-link ()
   "Function for `org-store-link-functions'."
@@ -443,72 +453,53 @@ that order.  Which is preferred is determined by
 
 (add-hook 'org-store-link-functions 'org-velocity-store-link)
 
-(defun org-velocity-create (search &optional ask)
+(defun* org-velocity-create (search &key 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? "))
     (let ((org-velocity-search search)
-	  (org-default-notes-file (org-velocity-use-file))
+	  (org-default-notes-file (org-velocity-bucket-file))
 	  ;; save a stored link
 	  org-store-link-plist)
-      (org-velocity-create-1))
+      (org-velocity-capture))
     search))
 
-(defun org-velocity-get-matches (search)
-  "Return matches for SEARCH in current bucket.
-Use method specified by `org-velocity-search-method'."
-  (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."
-  (with-current-buffer (org-velocity-display-buffer)
-    (erase-buffer)
-    (setq cursor-type nil))
-  (unless (or
-	   (not (stringp search))
-	   (string-equal "" search))	;exit on empty string
-    (case
-        (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))
-                         (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))
-		     (goto-char (point-min))
-		     (button-activate (next-button (point))))
-		 (org-velocity-read nil search))))))
+  (let ((org-velocity-search search))
+    (unless (or
+             (not (stringp search))
+             (string= "" search))	;exit on empty string
+      (case
+          (if (and org-velocity-force-new (eq last-command-event ?\C-j))
+              :force
+            (let ((matches (org-velocity-present search)))
+              (cond ((null matches) :new)
+                    ((org-velocity-singlep matches) :follow)
+                    (t :prompt))))
+        (:prompt (progn
+                   (pop-to-buffer (org-velocity-match-buffer))
+                   (let ((hint (org-velocity-electric-read-hint)))
+                     (when hint (case hint
+                                  (:edit (org-velocity-read nil search))
+                                  (:force (org-velocity-create search))
+                                  (otherwise (org-velocity-activate-button hint)))))))
+        (:new (unless (org-velocity-create search :ask 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-match-buffer))
+                       (goto-char (point-min))
+                       (button-activate (next-button (point))))
+                   (org-velocity-read nil search)))))))
 
 (defun org-velocity-position (item list)
   "Return first position of ITEM in LIST."
   (loop for elt in list
-	for i from 0
-	if (equal elt item)
-	return i))
+        for i from 0
+        when (equal elt item)
+        return i))
 
 (defun org-velocity-activate-button (char)
   "Go to button on line number associated with CHAR in `org-velocity-index'."
@@ -525,7 +516,11 @@ Use method specified by `org-velocity-search-method'."
   (interactive)
   (message "%s"
 	   (substitute-command-keys
-	    "\\[org-velocity-electric-new] for new entry, \\[org-velocity-electric-edit] to edit search, \\[scroll-up] to scroll."))
+	    "\\[org-velocity-electric-new] for new entry,
+\\[org-velocity-electric-edit] to edit search,
+\\[scroll-up] to scroll up,
+\\[scroll-down] to scroll down,
+\\[keyboard-quit] to quit."))
   (sit-for 4))
 
 (defun org-velocity-electric-follow (ev)
@@ -548,12 +543,12 @@ Use method specified by `org-velocity-search-method'."
 (defun org-velocity-electric-edit ()
   "Edit the search string."
   (interactive)
-  (throw 'org-velocity-select 'edit))
+  (throw 'org-velocity-select :edit))
 
 (defun org-velocity-electric-new ()
   "Force a new entry."
   (interactive)
-  (throw 'org-velocity-select 'force))
+  (throw 'org-velocity-select :force))
 
 (defvar org-velocity-electric-map
   (let ((map (make-sparse-keymap)))
@@ -561,26 +556,28 @@ Use method specified by `org-velocity-search-method'."
     (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)
-    (define-key map [return] 'org-velocity-electric-edit)
+    (define-key map "\C-v" 'scroll-up)
+    (define-key map "\M-v" 'scroll-down)
+    (define-key map (kbd "RET") 'org-velocity-electric-edit)
     (define-key map [mouse-1] 'org-velocity-electric-click)
     (define-key map [mouse-2] 'org-velocity-electric-click)
-    (define-key map [escape escape escape] 'keyboard-quit)
+    (define-key map [escape] 'keyboard-quit)
     (define-key map "\C-h" 'help-command)
     map))
 
-(defun org-velocity-electric-follow-hint ()
+(defun org-velocity-electric-read-hint ()
   "Read index of button electrically."
-  (with-current-buffer (org-velocity-display-buffer)
+  (with-current-buffer (org-velocity-match-buffer)
     (use-local-map org-velocity-electric-map)
     (catch 'org-velocity-select
-      (Electric-command-loop 'org-velocity-select
-			     "Follow: "))))
+      (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)
+    (define-key map "\C-v" 'scroll-up)
+    (define-key map "\M-v" 'scroll-down)
     map))
 
 (defun org-velocity-click-for-incremental ()
@@ -601,30 +598,24 @@ Use method specified by `org-velocity-search-method'."
      (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)))
+(defun org-velocity-update ()
+  "Display results of search without hinting.
+Stop searching once there are more matches than can be displayed."
+  (unless (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))))))
+           (matches (org-velocity-present search :hide-hints t)))
+      (cond ((null matches)
+             (select-window (active-minibuffer-window))
+             (unless (or (null search) (string= "" search))
+               (minibuffer-message "No match; RET to create")))
+            ((and (org-velocity-singlep matches)
+                  org-velocity-exit-on-match)
+             (throw 'click search))
+            (t
+             (with-current-buffer (org-velocity-match-buffer)
+               (use-local-map org-velocity-incremental-keymap)))))))
+
+(defvar dabbrev--last-abbrev)
 
 (defun org-velocity-dabbrev-completion-list (abbrev)
   "Return all dabbrev completions for ABBREV."
@@ -633,17 +624,25 @@ Use method specified by `org-velocity-search-method'."
   (setq dabbrev--last-abbrev abbrev)
   (dabbrev--find-all-expansions abbrev case-fold-search))
 
+(defvar org-velocity-local-completion-map
+  (let ((map (make-sparse-keymap)))
+    (set-keymap-parent map minibuffer-local-completion-map)
+    (define-key map " " 'self-insert-command)
+    (define-key map [remap minibuffer-complete] 'minibuffer-complete-word)
+    map)
+  "Keymap for completion with `completing-read'.")
+
 (defun org-velocity-read-with-completion (prompt)
   "Completing read with PROMPT."
   (let ((minibuffer-local-completion-map
-         minibuffer-local-filename-completion-map)
+         org-velocity-local-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))
+       (phrase #'completing-read)
+       (any    #'completing-read-multiple)
+       (all    #'completing-read-multiple))
      prompt
      (completion-table-dynamic
       'org-velocity-dabbrev-completion-list))))
@@ -660,30 +659,36 @@ Use method specified by `org-velocity-search-method'."
           (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)))
+      (if org-velocity-use-completion
 	  (org-velocity-read-with-completion prompt)
 	(read-string prompt)))))
 
-(defun org-velocity-read-incrementally (prompt)
+(defun org-velocity-incremental-read (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))))
+             (let* ((match-window (display-buffer (org-velocity-match-buffer)))
+                    (org-velocity-index
+                     ;; Truncate the index to the size of the buffer to be
+                     ;; displayed.
+                     (with-selected-window match-window
+                       (if (> (window-height) (length org-velocity-index))
+                           ;; (subseq org-velocity-index 0 (window-height))
+                           (let ((hints (copy-sequence org-velocity-index)))
+                             (setcdr (nthcdr (window-height) hints) nil)
+                             hints)
+                         org-velocity-index))))
+               (catch 'click
+                 (add-hook 'post-command-hook 'org-velocity-update)
+                 (if (eq org-velocity-search-method 'regexp)
+                     (read-regexp prompt)
+                   (if org-velocity-use-completion
+                       (org-velocity-read-with-completion prompt)
+                     (read-string prompt)))))
+           (remove-hook 'post-command-hook 'org-velocity-update))))
     (if (bufferp res) (org-pop-to-buffer-same-window res) res)))
 
-(defun org-velocity-read (arg &optional search)
+(defun org-velocity (arg &optional search)
   "Read a search string SEARCH for Org-Velocity interface.
 This means that a buffer will display all headings where SEARCH
 occurs, where one can be selected by a mouse click or by typing
@@ -693,22 +698,26 @@ created named SEARCH.
 If `org-velocity-bucket' is defined and
 `org-velocity-always-use-bucket' is non-nil, then the bucket file
 will be used; otherwise, this will work when called in any Org
-file.  Calling with ARG forces current file."
+file. Calling with ARG forces current file."
   (interactive "P")
   (let ((org-velocity-always-use-bucket
 	 (if arg nil org-velocity-always-use-bucket)))
     ;; complain if inappropriate
-    (assert (org-velocity-use-file))
-    (unwind-protect
-        (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)))))
+    (assert (org-velocity-bucket-file))
+    (let ((org-velocity-bucket-buffer
+           (find-file-noselect (org-velocity-bucket-file))))
+      (unwind-protect
+          (let ((dabbrev-search-these-buffers-only
+                 (list (org-velocity-bucket-buffer))))
+            (org-velocity-engine
+             (if org-velocity-search-is-incremental
+                 (org-velocity-incremental-read "Velocity search: ")
+               (org-velocity-read-string "Velocity search: " search))))
+        (progn
+          (kill-buffer (org-velocity-match-buffer))
+          (delete-other-windows))))))
+
+(defalias 'org-velocity-read 'org-velocity)
 
 (provide 'org-velocity)