emacs-orgmode@gnu.org archives
 help / color / mirror / code / Atom feed
* [PATCH] Org-Velocity incremental display
@ 2011-06-15 18:33 Paul M. Rodriguez
  2011-06-28 13:53 ` Bastien
  0 siblings, 1 reply; 2+ messages in thread
From: Paul M. Rodriguez @ 2011-06-15 18:33 UTC (permalink / raw)
  To: emacs-orgmode

[-- Attachment #1: Type: text/plain, Size: 201 bytes --]


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.

Paul Rodriguez.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-velocity.el.diff --]
[-- Type: text/x-diff, Size: 31863 bytes --]

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)))))

^ permalink raw reply related	[flat|nested] 2+ messages in thread

end of thread, other threads:[~2011-06-28 13:53 UTC | newest]

Thread overview: 2+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2011-06-15 18:33 [PATCH] Org-Velocity incremental display Paul M. Rodriguez
2011-06-28 13:53 ` Bastien

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs/org-mode.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).