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