* [PATCH] New version of org-velocity
@ 2014-10-27 19:06 Paul Rodriguez
2014-10-30 19:18 ` Marco Wahl
2014-12-01 15:27 ` Bastien
0 siblings, 2 replies; 12+ messages in thread
From: Paul Rodriguez @ 2014-10-27 19:06 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1.1: Type: text/plain, Size: 374 bytes --]
This is a new version of org-velocity. Principally it differs in using
cl-lib and lexical binding, but there are also some minor bugfixes for
presenting results on very large screens and compatibility with evil-mode.
Also, for anyone interested in org-velocity: there is now a development
repository on GitHub: <https://github.com/ruricolist/org-velocity>.
Paul Rodriguez
[-- Attachment #1.2: Type: text/html, Size: 523 bytes --]
[-- Attachment #2: 0001-New-version-of-Org-Velocity.patch --]
[-- Type: text/x-patch, Size: 25901 bytes --]
From 5cac25a0d21867bce9c6a24e10dff190ed92b566 Mon Sep 17 00:00:00 2001
From: "Paul M. Rodriguez" <pmr@ruricolist.com>
Date: Sun, 26 Oct 2014 17:13:18 -0500
Subject: [PATCH] New version of Org-Velocity
---
contrib/lisp/org-velocity.el | 309 ++++++++++++++++++++++--------------------
1 file changed, 163 insertions(+), 146 deletions(-)
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index e6788c6..a7820f1 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.
+;;; org-velocity.el --- something like Notational Velocity for Org. -*- lexical-binding: t -*-
;; Copyright (C) 2010-2014 Paul M. Rodriguez
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
-;; Version: 3.0
+;; Version: 4.0
;; This file is not part of GNU Emacs.
@@ -64,7 +64,7 @@
(require 'button)
(require 'electric)
(require 'dabbrev)
-(eval-when-compile (require 'cl))
+(require 'cl-lib)
(defgroup org-velocity nil
"Notational Velocity-style interface for Org."
@@ -133,9 +133,9 @@ file."
"Match on whole phrase, any word, or all words?"
:group 'org-velocity
:type '(choice
- (const :tag "Match whole phrase" phrase)
- (const :tag "Match any word" any)
- (const :tag "Match all words" all)
+ (const :tag "Match whole phrase" phrase)
+ (const :tag "Match any word" any)
+ (const :tag "Match all words" all)
(const :tag "Match a regular expression" regexp))
:safe (lambda (v) (memq v '(phrase any all regexp))))
@@ -152,6 +152,17 @@ See the documentation for `org-capture-templates'."
:group 'org-velocity
:type (or (get 'org-capture-templates 'custom-type) 'list))
+(defcustom org-velocity-heading-level 1
+ "Only match headings at this level or higher.
+0 means to match headings at any level."
+ :group 'org-velocity
+ :type 'integer
+ :safe (lambda (x)
+ (and (integerp x)
+ (>= x 0))))
+
+(defvar crm-separator) ;Ensure dynamic binding.
+
(defsubst org-velocity-grab-preview ()
"Grab preview of a subtree.
The length of the preview is determined by `window-width'.
@@ -172,14 +183,14 @@ Replace all contiguous whitespace with single spaces."
(point-max))))
" ")))
-(defstruct org-velocity-heading buffer position name level preview)
+(cl-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)
+ (re-search-backward (org-velocity-heading-regexp))
(let ((components (org-heading-components)))
(make-org-velocity-heading
:buffer (current-buffer)
@@ -191,15 +202,18 @@ If there is no last heading, return nil."
(defconst org-velocity-index
(eval-when-compile
- (nconc (number-sequence 49 57) ;numbers
+ (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-match-buffer-name "*Velocity matches*")
-(defconst org-velocity-heading-regexp "^\\* "
- "Regexp to match only top-level headings.")
+(cl-defun org-velocity-heading-regexp (&optional (level org-velocity-heading-level))
+ "Regexp to match headings at LEVEL or deeper."
+ (if (zerop level)
+ "^\\*+ "
+ (format "^\\*\\{1,%d\\} " level)))
(defvar org-velocity-search nil
"Variable to bind to current search.")
@@ -223,12 +237,6 @@ of the base buffer; in the latter, return the file name of
(with-current-buffer (window-buffer (active-minibuffer-window))
(minibuffer-contents))))
-(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;
@@ -260,17 +268,22 @@ use it."
"Return the proper buffer for Org-Velocity to display in."
(get-buffer-create org-velocity-match-buffer-name))
+(defsubst org-velocity-match-window ()
+ (get-buffer-window (org-velocity-match-buffer)))
+
+(defsubst org-velocity-match-staging-buffer ()
+ (get-buffer-create " Velocity matches"))
+
(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)))
+ (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 (org-velocity-heading-buffer heading))
(name (org-velocity-heading-name heading))
(existing (get-buffer name)))
@@ -279,7 +292,8 @@ use it."
existing
(make-indirect-buffer
bucket
- (generate-new-buffer-name (org-velocity-heading-name heading))))))
+ (generate-new-buffer-name (org-velocity-heading-name heading))
+ t))))
(defun org-velocity-capture ()
"Record a note with `org-capture'."
@@ -287,34 +301,38 @@ use it."
org-velocity-capture-templates))
(org-capture nil
;; This is no longer automatically selected.
- (when (org-velocity-singlep org-capture-templates)
+ (when (null (cdr org-capture-templates))
(caar org-capture-templates)))
- (if org-capture-mode (rename-buffer org-velocity-search t))))
+ (when 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 ((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))))))))
+ (let ((winconf (current-window-configuration))
+ (buffer (org-velocity-make-indirect-buffer heading))
+ (inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t))
+ (with-current-buffer buffer
+ (setq org-velocity-saved-winconf winconf)
+ (goto-char (org-velocity-heading-position heading))
+ (let ((start (point))
+ (end (save-excursion
+ (org-end-of-subtree t)
+ (point))))
+ ;; Outline view and narrow-to-region interact poorly.
+ (outline-flag-region start end nil)
+ (narrow-to-region start end))
+ (goto-char (point-max))
+ (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."
@@ -327,14 +345,18 @@ use it."
(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)))
+ (when org-velocity-use-search-ring
+ (add-to-history 'search-ring
+ (button-get button 'search)
+ search-ring-max))
+ (let ((match (button-get button 'match)))
+ (throw 'org-velocity-done
+ (lambda ()
+ (org-velocity-edit-entry match)))))
(define-button-type 'org-velocity-button
- 'action #'org-velocity-visit-button)
+ 'action #'org-velocity-visit-button
+ 'follow-link 'mouse-face)
(defsubst org-velocity-buttonize (heading)
"Insert HEADING as a text button with no hints."
@@ -352,8 +374,8 @@ use it."
(org-velocity-heading-preview heading)
'face 'shadow))))
-(defsubst* org-velocity-present-match (&key hint match)
- (with-current-buffer (org-velocity-match-buffer)
+(defsubst org-velocity-present-match (hint match)
+ (with-current-buffer (org-velocity-match-staging-buffer)
(when hint (insert "#" hint " "))
(org-velocity-buttonize match)
(org-velocity-insert-preview match)
@@ -362,19 +384,19 @@ use it."
(defun org-velocity-generic-search (search &optional hide-hints)
"Display any entry containing SEARCH."
(let ((hints org-velocity-index) matches)
- (block nil
+ (cl-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)
+ (unless hide-hints (car hints))
+ match)
(push match matches))
(setq hints (cdr hints))
- (unless (re-search-forward org-velocity-heading-regexp nil t)
+ (unless (re-search-forward (org-velocity-heading-regexp) nil t)
(return))))
(nreverse matches)))
-(defun* org-velocity-all-search (search &optional hide-hints max)
+(cl-defun org-velocity-all-search (search &optional hide-hints)
"Display only entries containing every word in SEARCH."
(let ((keywords (mapcar 'regexp-quote (split-string search)))
(hints org-velocity-index)
@@ -388,23 +410,23 @@ use it."
(setq org-map-continue-from
(save-excursion
(goto-char (line-end-position))
- (if (re-search-forward org-velocity-heading-regexp nil t)
+ (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)))
+ (when (cl-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)
+ (unless hide-hints (car hints))
+ match)
(push match matches)
(setq hints (cdr hints))))))
(nreverse matches)))
-(defun* org-velocity-present (search &key hide-hints)
+(cl-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'.
@@ -425,7 +447,7 @@ Return matches."
(inhibit-field-text-motion t))
(save-excursion
(org-velocity-beginning-of-headings)
- (case org-velocity-search-method
+ (cl-case org-velocity-search-method
(all (org-velocity-all-search search hide-hints))
(phrase (org-velocity-generic-search
(concat "\\<" (regexp-quote search))
@@ -440,6 +462,7 @@ Return matches."
(invalid-regexp
(minibuffer-message "%s" lossage))))))))
(with-current-buffer (org-velocity-match-buffer)
+ (buffer-swap-text (org-velocity-match-staging-buffer))
(goto-char (point-min)))))
(with-current-buffer (org-velocity-match-buffer)
(erase-buffer))))
@@ -452,14 +475,14 @@ Return matches."
(add-hook 'org-store-link-functions 'org-velocity-store-link)
-(defun* org-velocity-create (search &key ask)
+(cl-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-bucket-file))
- ;; save a stored link
- org-store-link-plist)
+ (org-default-notes-file (org-velocity-bucket-file))
+ ;; save a stored link
+ org-store-link-plist)
(org-velocity-capture))
search))
@@ -469,17 +492,18 @@ If ASK is non-nil, ask first."
(unless (or
(not (stringp search))
(string= "" search)) ;exit on empty string
- (case
+ (cl-case
(if (and org-velocity-force-new (eq last-command-event ?\C-j))
:force
- (let ((matches (org-velocity-present search)))
+ (let* ((org-velocity-index (org-velocity-adjust-index))
+ (matches (org-velocity-present search)))
(cond ((null matches) :new)
- ((org-velocity-singlep matches) :follow)
+ ((null (cdr matches)) :follow)
(t :prompt))))
(:prompt (progn
(pop-to-buffer (org-velocity-match-buffer))
(let ((hint (org-velocity-electric-read-hint)))
- (when hint (case hint
+ (when hint (cl-case hint
(:edit (org-velocity-read nil search))
(:force (org-velocity-create search))
(otherwise (org-velocity-activate-button hint)))))))
@@ -493,17 +517,10 @@ If ASK is non-nil, ask first."
(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
- 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'."
(goto-char (point-min))
- (forward-line (org-velocity-position char org-velocity-index))
+ (forward-line (cl-position char org-velocity-index))
(goto-char
(button-start
(next-button (point))))
@@ -514,8 +531,8 @@ If ASK is non-nil, ask first."
"Complain about an undefined key."
(interactive)
(message "%s"
- (substitute-command-keys
- "\\[org-velocity-electric-new] for new entry,
+ (substitute-command-keys
+ "\\[org-velocity-electric-new] for new entry,
\\[org-velocity-electric-edit] to edit search,
\\[scroll-up] to scroll up,
\\[scroll-down] to scroll down,
@@ -525,20 +542,11 @@ If ASK is non-nil, ask first."
(defun org-velocity-electric-follow (ev)
"Follow a hint indexed by keyboard event EV."
(interactive (list last-command-event))
- (if (not (> (org-velocity-position ev org-velocity-index)
+ (if (not (> (cl-position ev org-velocity-index)
(1- (count-lines (point-min) (point-max)))))
(throw 'org-velocity-select ev)
(call-interactively 'org-velocity-electric-undefined)))
-(defun org-velocity-electric-click (ev)
- "Follow hint indexed by a mouse event EV."
- (interactive "e")
- (throw 'org-velocity-select
- (nth (1- (count-lines
- (point-min)
- (posn-point (event-start ev))))
- org-velocity-index)))
-
(defun org-velocity-electric-edit ()
"Edit the search string."
(interactive)
@@ -552,14 +560,15 @@ If ASK is non-nil, ask first."
(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
- do (define-key map (char-to-string c) 'org-velocity-electric-follow))
+ (dolist (c org-velocity-index)
+ (define-key map (char-to-string c)
+ 'org-velocity-electric-follow))
(define-key map "0" 'org-velocity-electric-new)
(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 [mouse-1] nil)
+ (define-key map [mouse-2] nil)
(define-key map [escape] 'keyboard-quit)
(define-key map "\C-h" 'help-command)
map))
@@ -567,29 +576,19 @@ If ASK is non-nil, ask first."
(defun org-velocity-electric-read-hint ()
"Read index of button electrically."
(with-current-buffer (org-velocity-match-buffer)
+ (when (featurep 'evil)
+ ;; NB Idempotent.
+ (evil-make-overriding-map org-velocity-electric-map))
(use-local-map org-velocity-electric-map)
(catch 'org-velocity-select
(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 ()
- "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
@@ -598,8 +597,7 @@ If ASK is non-nil, ask first."
'completion-list-mode))))
(defun org-velocity-update ()
- "Display results of search without hinting.
-Stop searching once there are more matches than can be displayed."
+ "Display results of search without hinting."
(unless (org-velocity-displaying-completions-p)
(let* ((search (org-velocity-minibuffer-contents))
(matches (org-velocity-present search :hide-hints t)))
@@ -607,20 +605,20 @@ Stop searching once there are more matches than can be displayed."
(select-window (active-minibuffer-window))
(unless (or (null search) (string= "" search))
(minibuffer-message "No match; RET to create")))
- ((and (org-velocity-singlep matches)
+ ((and (null (cdr 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)
+(defvar dabbrev--last-abbreviation)
(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)
+ (setq dabbrev--last-abbreviation abbrev)
(dabbrev--find-all-expansions abbrev case-fold-search))
(defvar org-velocity-local-completion-map
@@ -638,7 +636,7 @@ Stop searching once there are more matches than can be displayed."
(completion-no-auto-exit t)
(crm-separator " "))
(funcall
- (case org-velocity-search-method
+ (cl-case org-velocity-search-method
(phrase #'completing-read)
(any #'completing-read-multiple)
(all #'completing-read-multiple))
@@ -652,38 +650,50 @@ Stop searching once there are more matches than can be displayed."
;; `read-from-minibuffer'), but in this case it is the user-friendly
;; thing to do.
(minibuffer-with-setup-hook
- (lexical-let ((initial-input initial-input))
+ (let ((initial-input initial-input))
(lambda ()
(and initial-input (insert initial-input))
(goto-char (point-max))))
(if (eq org-velocity-search-method 'regexp)
- (read-regexp prompt)
+ (read-regexp prompt)
(if org-velocity-use-completion
- (org-velocity-read-with-completion prompt)
- (read-string prompt)))))
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt)))))
+
+(cl-defun org-velocity-adjust-index
+ (&optional (match-window (org-velocity-match-window)))
+ "Truncate or extend `org-velocity-index' to the lines in
+MATCH-WINDOW."
+ (with-selected-window match-window
+ (let ((lines (window-height))
+ (hints (length org-velocity-index)))
+ (cond ((= lines hints)
+ org-velocity-index)
+ ;; Truncate the index to the size of
+ ;; the buffer to be displayed.
+ ((< lines hints)
+ (cl-subseq org-velocity-index 0 lines))
+ ;; If the window is so tall we run out of indices, at
+ ;; least make the additional results clickable.
+ ((> lines hints)
+ (append org-velocity-index
+ (make-list (- lines hints) nil)))))))
(defun org-velocity-incremental-read (prompt)
- "Read string with PROMPT and display results incrementally."
+ "Read string with PROMPT and display results incrementally.
+Stop searching once there are more matches than can be
+displayed."
(let ((res
(unwind-protect
(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))))
+ (org-velocity-index (org-velocity-adjust-index match-window)))
(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)))))
+ (cond ((eq org-velocity-search-method 'regexp)
+ (read-regexp prompt))
+ (org-velocity-use-completion
+ (org-velocity-read-with-completion prompt))
+ (t (read-string prompt)))))
(remove-hook 'post-command-hook 'org-velocity-update))))
(if (bufferp res) (org-pop-to-buffer-same-window res) res)))
@@ -697,24 +707,31 @@ 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 reverses which file – the current file or the
+bucket file – to use. If the bucket file would have been used,
+then the current file is used instead, and vice versa."
(interactive "P")
(let ((org-velocity-always-use-bucket
- (if arg nil org-velocity-always-use-bucket)))
+ (if org-velocity-always-use-bucket
+ (not arg)
+ arg)))
;; complain if inappropriate
- (assert (org-velocity-bucket-file))
+ (cl-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))))))
+ (funcall
+ (catch 'org-velocity-done
+ (org-velocity-engine
+ (if org-velocity-search-is-incremental
+ (org-velocity-incremental-read "Velocity search: ")
+ (org-velocity-read-string "Velocity search: " search)))
+ #'ignore)))
+ (kill-buffer (org-velocity-match-buffer))))))
(defalias 'org-velocity-read 'org-velocity)
--
1.7.9.5
^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-27 19:06 [PATCH] New version of org-velocity Paul Rodriguez
@ 2014-10-30 19:18 ` Marco Wahl
2014-10-30 19:55 ` Paul Rodriguez
2014-10-31 19:17 ` Achim Gratz
2014-12-01 15:27 ` Bastien
1 sibling, 2 replies; 12+ messages in thread
From: Marco Wahl @ 2014-10-30 19:18 UTC (permalink / raw)
To: Paul Rodriguez; +Cc: emacs-orgmode
Hello Paul,
Paul Rodriguez <pmr@ruricolist.com> writes:
> This is a new version of org-velocity. Principally it differs in using
> cl-lib and lexical binding, but there are also some minor bugfixes for
> presenting results on very large screens and compatibility with
> evil-mode.
Thanks for sharing.
Is there any reason not bringing your new version into the master
branch?
Best regards, Marco
--
http://www.wahlzone.de
GPG: 0x0A3AE6F2
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-30 19:18 ` Marco Wahl
@ 2014-10-30 19:55 ` Paul Rodriguez
2014-10-31 7:58 ` Marco Wahl
2014-10-31 19:17 ` Achim Gratz
1 sibling, 1 reply; 12+ messages in thread
From: Paul Rodriguez @ 2014-10-30 19:55 UTC (permalink / raw)
To: Marco Wahl; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 654 bytes --]
I'm afraid I don't understand the question. Is there a problem with the
patch?
Paul Rodriguez.
On Thu, Oct 30, 2014 at 2:18 PM, Marco Wahl <marcowahlsoft@gmail.com> wrote:
> Hello Paul,
>
> Paul Rodriguez <pmr@ruricolist.com> writes:
>
> > This is a new version of org-velocity. Principally it differs in using
> > cl-lib and lexical binding, but there are also some minor bugfixes for
> > presenting results on very large screens and compatibility with
> > evil-mode.
>
> Thanks for sharing.
>
> Is there any reason not bringing your new version into the master
> branch?
>
>
> Best regards, Marco
> --
> http://www.wahlzone.de
> GPG: 0x0A3AE6F2
>
[-- Attachment #2: Type: text/html, Size: 1333 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-30 19:55 ` Paul Rodriguez
@ 2014-10-31 7:58 ` Marco Wahl
2014-10-31 19:22 ` Paul Rodriguez
0 siblings, 1 reply; 12+ messages in thread
From: Marco Wahl @ 2014-10-31 7:58 UTC (permalink / raw)
To: Paul Rodriguez; +Cc: emacs-orgmode
Paul Rodriguez <pmr@ruricolist.com> writes:
> I'm afraid I don't understand the question. Is there a problem with the
> patch?
AFAICS there is no problem with your patch.
I just wonder about how your patch could be applied to the repository.
Can you do this?
Best regards, Marco
--
http://www.wahlzone.de
GPG: 0x0A3AE6F2
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-30 19:18 ` Marco Wahl
2014-10-30 19:55 ` Paul Rodriguez
@ 2014-10-31 19:17 ` Achim Gratz
1 sibling, 0 replies; 12+ messages in thread
From: Achim Gratz @ 2014-10-31 19:17 UTC (permalink / raw)
To: emacs-orgmode
Marco Wahl writes:
> Is there any reason not bringing your new version into the master
> branch?
I'm not certain about the current maintainer policy w.r.t. backwards
compatibility for older Emacsen, but this patch would work with Emacs 24
only due to its use of lexical binding.
Regards,
Achim.
--
+<[Q+ Matrix-12 WAVE#46+305 Neuron microQkb Andromeda XTk Blofeld]>+
SD adaptation for Waldorf microQ V2.22R2:
http://Synth.Stromeko.net/Downloads.html#WaldorfSDada
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-31 7:58 ` Marco Wahl
@ 2014-10-31 19:22 ` Paul Rodriguez
2014-11-04 10:33 ` Marco Wahl
0 siblings, 1 reply; 12+ messages in thread
From: Paul Rodriguez @ 2014-10-31 19:22 UTC (permalink / raw)
To: Marco Wahl; +Cc: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 738 bytes --]
I am not a committer. Previously I've always sent in new versions of
org-velocity as patches, following the procedure on the Org wiki. I don't
usually follow the mailing list, so perhaps the procedure for handling
contributions has changed without my noticing. If so I'm happy to adjust.
Paul Rodriguez.
On Fri, Oct 31, 2014 at 2:58 AM, Marco Wahl <marcowahlsoft@gmail.com> wrote:
> Paul Rodriguez <pmr@ruricolist.com> writes:
>
> > I'm afraid I don't understand the question. Is there a problem with the
> > patch?
>
> AFAICS there is no problem with your patch.
>
> I just wonder about how your patch could be applied to the repository.
> Can you do this?
>
>
> Best regards, Marco
> --
> http://www.wahlzone.de
> GPG: 0x0A3AE6F2
>
[-- Attachment #2: Type: text/html, Size: 1304 bytes --]
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-31 19:22 ` Paul Rodriguez
@ 2014-11-04 10:33 ` Marco Wahl
2014-12-01 15:43 ` Bastien
0 siblings, 1 reply; 12+ messages in thread
From: Marco Wahl @ 2014-11-04 10:33 UTC (permalink / raw)
To: emacs-orgmode; +Cc: Paul Rodriguez
Hi Paul!
Paul Rodriguez <pmr@ruricolist.com> writes:
> I am not a committer. Previously I've always sent in new versions of
> org-velocity as patches, following the procedure on the Org wiki. I
> don't usually follow the mailing list, so perhaps the procedure for
> handling contributions has changed without my noticing. If so I'm
> happy to adjust.
Have you seen the post of Achim about the lexical binding issue?
http://permalink.gmane.org/gmane.emacs.orgmode/92261
What do you think?
Best regards, Marco
--
http://www.wahlzone.de
GPG: 0x0A3AE6F2
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-10-27 19:06 [PATCH] New version of org-velocity Paul Rodriguez
2014-10-30 19:18 ` Marco Wahl
@ 2014-12-01 15:27 ` Bastien
1 sibling, 0 replies; 12+ messages in thread
From: Bastien @ 2014-12-01 15:27 UTC (permalink / raw)
To: Paul Rodriguez; +Cc: emacs-orgmode
Hi Paul,
Paul Rodriguez <pmr@ruricolist.com> writes:
> This is a new version of org-velocity.
Applied, thanks a lot!
--
Bastien
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2014-11-04 10:33 ` Marco Wahl
@ 2014-12-01 15:43 ` Bastien
0 siblings, 0 replies; 12+ messages in thread
From: Bastien @ 2014-12-01 15:43 UTC (permalink / raw)
To: Marco Wahl; +Cc: Paul Rodriguez, emacs-orgmode
Hi Paul and Marco,
Marco Wahl <marcowahlsoft@gmail.com> writes:
> Have you seen the post of Achim about the lexical binding issue?
> http://permalink.gmane.org/gmane.emacs.orgmode/92261
>
> What do you think?
While this is worth looking at the issue, it is not a problem wrt
applying the patch, as we don't enforce compatibility for projects
in the contrib/ directory.
2 cents!
--
Bastien
^ permalink raw reply [flat|nested] 12+ messages in thread
* [PATCH] New version of org-velocity
@ 2015-12-15 0:03 Paul Rodriguez
2015-12-15 17:19 ` Marco Wahl
2015-12-16 7:44 ` Marco Wahl
0 siblings, 2 replies; 12+ messages in thread
From: Paul Rodriguez @ 2015-12-15 0:03 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1.1: Type: text/plain, Size: 292 bytes --]
This updates the version of org-velocity in contrib to the latest version.
The new version supports an Ido-like style of refining searches
interactively, and changes the default behavior to better accommodate users
who use org-velocity for navigation instead of note-taking.
Paul Rodriguez
[-- Attachment #1.2: Type: text/html, Size: 366 bytes --]
[-- Attachment #2: 0001-org-velocity-New-version-of-org-velocity.patch --]
[-- Type: text/x-patch, Size: 21562 bytes --]
From 6b073644a65a6a145c2b916c258fe05b68ac3e48 Mon Sep 17 00:00:00 2001
From: "Paul M. Rodriguez" <pmr@ruricolist.com>
Date: Mon, 14 Dec 2015 17:51:40 -0600
Subject: [PATCH] org-velocity: New version of org-velocity.
* contrib/lisp/org-velocity.el: New version.
---
contrib/lisp/org-velocity.el | 387 ++++++++++++++++++++++++++-----------------
1 file changed, 233 insertions(+), 154 deletions(-)
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index a7820f1..bfc4d6c 100644
--- a/contrib/lisp/org-velocity.el
+++ b/contrib/lisp/org-velocity.el
@@ -4,7 +4,7 @@
;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
;; Created: 2010-05-05
-;; Version: 4.0
+;; Version: 4.1
;; This file is not part of GNU Emacs.
@@ -78,12 +78,6 @@
: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-show-previews t
"Show previews of the text of each heading?"
:group 'velocity
@@ -168,20 +162,27 @@ See the documentation for `org-capture-templates'."
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))))
- " ")))
+ (let* ((start (progn
+ (forward-line 1)
+ (if (looking-at org-property-start-re)
+ (re-search-forward org-property-end-re)
+ (1- (point)))))
+ (string+props (buffer-substring
+ start
+ (min
+ (+ start (window-width))
+ (point-max)))))
+ ;; We want to preserve the text properties so that, for example,
+ ;; we don't end up with the raw text of links in the preview.
+ (with-temp-buffer
+ (insert string+props)
+ (goto-char (point-min))
+ (save-match-data
+ (while (re-search-forward split-string-default-separators
+ (point-max)
+ t)
+ (replace-match " ")))
+ (buffer-string))))
(cl-defstruct org-velocity-heading buffer position name level preview)
@@ -233,9 +234,16 @@ of the base buffer; in the latter, return the file name of
(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))))
+ (when (active-minibuffer-window)
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (minibuffer-contents))))
+
+(defun org-velocity-nix-minibuffer ()
+ "Return the contents of the minibuffer and clear it."
+ (when (active-minibuffer-window)
+ (with-current-buffer (window-buffer (active-minibuffer-window))
+ (prog1 (minibuffer-contents)
+ (delete-minibuffer-contents)))))
(defun org-velocity-bucket-file ()
"Return the proper file for Org-Velocity to search.
@@ -259,6 +267,7 @@ use it."
(error "No bucket and not an Org file"))))))
(defvar org-velocity-bucket-buffer nil)
+(defvar org-velocity-navigating nil)
(defsubst org-velocity-bucket-buffer ()
(or org-velocity-bucket-buffer
@@ -271,9 +280,6 @@ use it."
(defsubst org-velocity-match-window ()
(get-buffer-window (org-velocity-match-buffer)))
-(defsubst org-velocity-match-staging-buffer ()
- (get-buffer-create " Velocity matches"))
-
(defun org-velocity-beginning-of-headings ()
"Goto the start of the first heading."
(goto-char (point-min))
@@ -310,29 +316,47 @@ use it."
(make-variable-buffer-local 'org-velocity-saved-winconf)
(defun org-velocity-edit-entry (heading)
+ (if org-velocity-navigating
+ (org-velocity-edit-entry/inline heading)
+ (org-velocity-edit-entry/indirect heading)))
+
+(cl-defun org-velocity-goto-entry (heading &key narrow)
+ (goto-char (org-velocity-heading-position heading))
+ (save-excursion
+ (when narrow
+ (org-narrow-to-subtree))
+ (outline-show-all)))
+
+(defun org-velocity-edit-entry/inline (heading)
+ "Edit entry at HEADING in the original buffer."
+ (let ((buffer (org-velocity-heading-buffer heading)))
+ (pop-to-buffer buffer)
+ (with-current-buffer buffer
+ (org-velocity-goto-entry heading))))
+
+(defun org-velocity-format-header-line (control-string &rest args)
+ (set (make-local-variable 'header-line-format)
+ (apply #'format control-string args)))
+
+(defun org-velocity-edit-entry/indirect (heading)
"Edit entry at HEADING in an indirect buffer."
(let ((winconf (current-window-configuration))
+ (dd default-directory)
(buffer (org-velocity-make-indirect-buffer heading))
(inhibit-point-motion-hooks t)
(inhibit-field-text-motion t))
(with-current-buffer buffer
+ (setq default-directory dd) ;Inherit default directory.
(setq org-velocity-saved-winconf winconf)
- (goto-char (org-velocity-heading-position heading))
- (let ((start (point))
- (end (save-excursion
- (org-end-of-subtree t)
- (point))))
- ;; Outline view and narrow-to-region interact poorly.
- (outline-flag-region start end nil)
- (narrow-to-region start end))
+ (org-velocity-goto-entry heading :narrow t)
(goto-char (point-max))
(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)))))))
+ (org-velocity-format-header-line
+ "%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."
@@ -350,9 +374,7 @@ use it."
(button-get button 'search)
search-ring-max))
(let ((match (button-get button 'match)))
- (throw 'org-velocity-done
- (lambda ()
- (org-velocity-edit-entry match)))))
+ (throw 'org-velocity-done match)))
(define-button-type 'org-velocity-button
'action #'org-velocity-visit-button
@@ -374,57 +396,113 @@ use it."
(org-velocity-heading-preview heading)
'face 'shadow))))
+(defvar org-velocity-recursive-headings nil)
+(defvar org-velocity-recursive-search nil)
+
+(cl-defun org-velocity-search-with (fun style search
+ &key (headings org-velocity-recursive-headings))
+ (if headings
+ (save-restriction
+ (dolist (heading headings)
+ (widen)
+ (let ((start (org-velocity-heading-position heading)))
+ (goto-char start)
+ (let ((end (save-excursion
+ (org-end-of-subtree)
+ (point))))
+ (narrow-to-region start end)
+ (org-velocity-search-with fun style search
+ :headings nil)))))
+ (cl-ecase style
+ ((phrase any regexp)
+ (cl-block nil
+ (while (re-search-forward search nil t)
+ (let ((match (org-velocity-nearest-heading (point))))
+ (funcall fun match))
+ ;; Skip to the next heading.
+ (unless (re-search-forward (org-velocity-heading-regexp) nil t)
+ (cl-return)))))
+ ((all)
+ (let ((keywords
+ (cl-loop for word in (split-string search)
+ collect (concat "\\<" (regexp-quote word) "\\>"))))
+ (org-map-entries
+ (lambda ()
+ ;; Only search the subtree once.
+ (setq org-map-continue-from
+ (save-excursion
+ (org-end-of-subtree)
+ (point)))
+ (when (cl-loop for word in keywords
+ always (save-excursion
+ (re-search-forward word org-map-continue-from t)))
+ (let ((match (org-velocity-nearest-heading (match-end 0))))
+ (funcall fun match))))))))))
+
+(defun org-velocity-all-results (style search)
+ (with-current-buffer (org-velocity-bucket-buffer)
+ (save-excursion
+ (goto-char (point-min))
+ (let (matches)
+ (org-velocity-search-with (lambda (match)
+ (push match matches))
+ style
+ search)
+ (nreverse matches)))))
+
(defsubst org-velocity-present-match (hint match)
- (with-current-buffer (org-velocity-match-staging-buffer)
+ (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."
+(defun org-velocity-present-search (style search hide-hints)
(let ((hints org-velocity-index) matches)
(cl-block nil
- (while (and hints (re-search-forward search nil t))
- (let ((match (org-velocity-nearest-heading (point))))
- (org-velocity-present-match
- (unless hide-hints (car hints))
- match)
- (push match matches))
- (setq hints (cdr hints))
- (unless (re-search-forward (org-velocity-heading-regexp) nil t)
- (return))))
+ (org-velocity-search-with (lambda (match)
+ (unless hints
+ (cl-return))
+ (let ((hint (if hide-hints
+ nil
+ (car hints))))
+ (org-velocity-present-match hint match))
+ (pop hints)
+ (push match matches))
+ style
+ search))
(nreverse matches)))
-(cl-defun org-velocity-all-search (search &optional hide-hints)
- "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 (cl-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
- (unless hide-hints (car hints))
- match)
- (push match matches)
- (setq hints (cdr hints))))))
- (nreverse matches)))
+(defun org-velocity-restrict-search ()
+ (interactive)
+ (let ((search (org-velocity-nix-minibuffer)))
+ (when (equal search "")
+ (error "No search to restrict to"))
+ (push search org-velocity-recursive-search)
+ (setq org-velocity-recursive-headings
+ (org-velocity-all-results
+ org-velocity-search-method
+ search))
+ ;; TODO We could extend the current search instead of starting
+ ;; over.
+ (org-velocity-update-match-header)
+ (minibuffer-message "Restricting search to %s" search)))
+
+(cl-defun org-velocity-update-match-header (&key (match-buffer (org-velocity-match-buffer))
+ (bucket-buffer (org-velocity-bucket-buffer))
+ (search-method org-velocity-search-method))
+ (let ((navigating? org-velocity-navigating)
+ (recursive? org-velocity-recursive-search))
+ (with-current-buffer match-buffer
+ (org-velocity-format-header-line
+ "%s search in %s%s (%s mode)"
+ (capitalize (symbol-name search-method))
+ (abbreviate-file-name (buffer-file-name bucket-buffer))
+ (if (not recursive?)
+ ""
+ (let ((sep " > "))
+ (concat sep (string-join (reverse recursive?) sep))))
+ (if navigating? "nav" "notes")))))
(cl-defun org-velocity-present (search &key hide-hints)
"Buttonize matches for SEARCH in `org-velocity-match-buffer'.
@@ -432,40 +510,49 @@ 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)
- (cl-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)
- (buffer-swap-text (org-velocity-match-staging-buffer))
- (goto-char (point-min)))))
- (with-current-buffer (org-velocity-match-buffer)
- (erase-buffer))))
+ (let ((match-buffer (org-velocity-match-buffer))
+ (bucket-buffer (org-velocity-bucket-buffer))
+ (search-method org-velocity-search-method))
+ (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 match-buffer
+ (erase-buffer)
+ ;; Permanent locals.
+ (setq cursor-type nil
+ truncate-lines t)
+ (org-velocity-update-match-header
+ :match-buffer match-buffer
+ :bucket-buffer bucket-buffer
+ :search-method search-method))
+ (prog1
+ (with-current-buffer bucket-buffer
+ (widen)
+ (let* ((inhibit-point-motion-hooks t)
+ (inhibit-field-text-motion t)
+ (anchored? (string-match-p "^\\s-" search))
+ (search
+ (cl-ecase search-method
+ (all search)
+ (phrase
+ (if anchored?
+ (regexp-quote search)
+ ;; Anchor the search to the start of a word.
+ (concat "\\<" (regexp-quote search))))
+ (any
+ (concat "\\<" (regexp-opt (split-string search))))
+ (regexp search))))
+ (save-excursion
+ (org-velocity-beginning-of-headings)
+ (condition-case lossage
+ (org-velocity-present-search search-method search hide-hints)
+ (invalid-regexp
+ (minibuffer-message "%s" lossage))))))
+ (with-current-buffer match-buffer
+ (goto-char (point-min)))))
+ (with-current-buffer match-buffer
+ (erase-buffer)))))
(defun org-velocity-store-link ()
"Function for `org-store-link-functions'."
@@ -603,7 +690,7 @@ If ASK is non-nil, ask first."
(matches (org-velocity-present search :hide-hints t)))
(cond ((null matches)
(select-window (active-minibuffer-window))
- (unless (or (null search) (string= "" search))
+ (unless (or (null search) (= (length search) 0))
(minibuffer-message "No match; RET to create")))
((and (null (cdr matches))
org-velocity-exit-on-match)
@@ -625,7 +712,10 @@ If ASK is non-nil, ask first."
(let ((map (make-sparse-keymap)))
(set-keymap-parent map minibuffer-local-completion-map)
(define-key map " " 'self-insert-command)
+ (define-key map "?" 'self-insert-command)
(define-key map [remap minibuffer-complete] 'minibuffer-complete-word)
+ (define-key map [(control ?@)] 'org-velocity-restrict-search)
+ (define-key map [(control ?\s)] 'org-velocity-restrict-search)
map)
"Keymap for completion with `completing-read'.")
@@ -635,30 +725,9 @@ If ASK is non-nil, ask first."
org-velocity-local-completion-map)
(completion-no-auto-exit t)
(crm-separator " "))
- (funcall
- (cl-case org-velocity-search-method
- (phrase #'completing-read)
- (any #'completing-read-multiple)
- (all #'completing-read-multiple))
- prompt
- (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."
- ;; The use of initial inputs to the minibuffer is deprecated (see
- ;; `read-from-minibuffer'), but in this case it is the user-friendly
- ;; thing to do.
- (minibuffer-with-setup-hook
- (let ((initial-input initial-input))
- (lambda ()
- (and initial-input (insert initial-input))
- (goto-char (point-max))))
- (if (eq org-velocity-search-method 'regexp)
- (read-regexp prompt)
- (if org-velocity-use-completion
- (org-velocity-read-with-completion prompt)
- (read-string prompt)))))
+ (completing-read prompt
+ (completion-table-dynamic
+ 'org-velocity-dabbrev-completion-list))))
(cl-defun org-velocity-adjust-index
(&optional (match-window (org-velocity-match-window)))
@@ -719,18 +788,28 @@ then the current file is used instead, and vice versa."
arg)))
;; complain if inappropriate
(cl-assert (org-velocity-bucket-file))
- (let ((org-velocity-bucket-buffer
- (find-file-noselect (org-velocity-bucket-file))))
+ (let* ((starting-buffer (current-buffer))
+ (org-velocity-bucket-buffer
+ (find-file-noselect (org-velocity-bucket-file)))
+ (org-velocity-navigating
+ (eq starting-buffer org-velocity-bucket-buffer))
+ (org-velocity-recursive-headings '())
+ (org-velocity-recursive-search '())
+ (org-velocity-heading-level
+ (if org-velocity-navigating
+ 0
+ org-velocity-heading-level))
+ (dabbrev-search-these-buffers-only
+ (list org-velocity-bucket-buffer)))
(unwind-protect
- (let ((dabbrev-search-these-buffers-only
- (list (org-velocity-bucket-buffer))))
- (funcall
- (catch 'org-velocity-done
- (org-velocity-engine
- (if org-velocity-search-is-incremental
- (org-velocity-incremental-read "Velocity search: ")
- (org-velocity-read-string "Velocity search: " search)))
- #'ignore)))
+ (let ((match
+ (catch 'org-velocity-done
+ (org-velocity-engine
+ (or search
+ (org-velocity-incremental-read "Velocity search: ")))
+ nil)))
+ (when (org-velocity-heading-p match)
+ (org-velocity-edit-entry match)))
(kill-buffer (org-velocity-match-buffer))))))
(defalias 'org-velocity-read 'org-velocity)
--
1.9.1
^ permalink raw reply related [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2015-12-15 0:03 Paul Rodriguez
@ 2015-12-15 17:19 ` Marco Wahl
2015-12-16 7:44 ` Marco Wahl
1 sibling, 0 replies; 12+ messages in thread
From: Marco Wahl @ 2015-12-15 17:19 UTC (permalink / raw)
To: emacs-orgmode; +Cc: paulmrodriguez
Hi Paul,
FWIW I like your package! And thanks!
Paul Rodriguez <paulmrodriguez@gmail.com> writes:
> This updates the version of org-velocity in contrib to the latest version.
>
> The new version supports an Ido-like style of refining searches
> interactively, and changes the default behavior to better accommodate users
> who use org-velocity for navigation instead of note-taking.
>
> Paul Rodriguez
>
> This updates the version of org-velocity in contrib to the latest version.
>
> The new version supports an Ido-like style of refining searches
> interactively, and changes the default behavior to better accommodate
> users who use org-velocity for navigation instead of note-taking.
May I update your package in the repo?
Best regards,
--
Marco Wahl
GPG: 0x49010A040A3AE6F2
^ permalink raw reply [flat|nested] 12+ messages in thread
* Re: [PATCH] New version of org-velocity
2015-12-15 0:03 Paul Rodriguez
2015-12-15 17:19 ` Marco Wahl
@ 2015-12-16 7:44 ` Marco Wahl
1 sibling, 0 replies; 12+ messages in thread
From: Marco Wahl @ 2015-12-16 7:44 UTC (permalink / raw)
To: emacs-orgmode
Hi Paul,
> This updates the version of org-velocity in contrib to the latest
> version.
>
> The new version supports an Ido-like style of refining searches
> interactively, and changes the default behavior to better accommodate
> users who use org-velocity for navigation instead of note-taking.
I just pushed org-velocity 4.1 to maint and to master.
Best regards,
--
Marco Wahl
GPG: 0x49010A040A3AE6F2
^ permalink raw reply [flat|nested] 12+ messages in thread
end of thread, other threads:[~2015-12-16 7:44 UTC | newest]
Thread overview: 12+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2014-10-27 19:06 [PATCH] New version of org-velocity Paul Rodriguez
2014-10-30 19:18 ` Marco Wahl
2014-10-30 19:55 ` Paul Rodriguez
2014-10-31 7:58 ` Marco Wahl
2014-10-31 19:22 ` Paul Rodriguez
2014-11-04 10:33 ` Marco Wahl
2014-12-01 15:43 ` Bastien
2014-10-31 19:17 ` Achim Gratz
2014-12-01 15:27 ` Bastien
-- strict thread matches above, loose matches on Subject: below --
2015-12-15 0:03 Paul Rodriguez
2015-12-15 17:19 ` Marco Wahl
2015-12-16 7:44 ` Marco Wahl
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).