* [PATCH] org-velocity and org-remember
@ 2010-11-03 23:22 Paul M. Rodriguez
2010-11-04 21:53 ` Jeff Horn
2010-11-15 10:23 ` [Accepted] " Carsten Dominik
0 siblings, 2 replies; 3+ messages in thread
From: Paul M. Rodriguez @ 2010-11-03 23:22 UTC (permalink / raw)
To: emacs-orgmode
[-- Attachment #1: Type: text/plain, Size: 214 bytes --]
This patch supports org-capture (with fallback to org-remember) for
org-velocity. It also effects some internal changes, principally due to
the use of `Electric-command-loop' to replace an expedient equivalent.
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: org-velocity.patch --]
[-- Type: text/x-diff, Size: 17509 bytes --]
diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
index 3e7453b..2a1f41b 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: 2.1
+;; Version: 2.2
;; This file is not part of GNU Emacs.
@@ -59,23 +59,23 @@
;; 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. When
-;; org-remember is loaded, or the user customizes
-;; `org-velocity-use-remember', then org-remember is used to insert
-;; the new heading. Otherwise the user is simply taken to a new
-;; heading at the end of the file.
+;; 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.
;; Thanks to Richard Riley, Carsten Dominik, and Bastien Guerry for
;; their suggestions.
;;; Usage:
-;;; (require 'org-velocity)
-;;; (setq org-velocity-bucket (concat org-directory "/bucket.org"))
-;;; (global-set-key (kbd "C-c v") 'org-velocity-read)
+;; (require 'org-velocity)
+;; (setq org-velocity-bucket (concat org-directory "/bucket.org"))
+;; (global-set-key (kbd "C-c v") 'org-velocity-read)
;;; Code:
(require 'org)
(require 'button)
+(require 'electric)
(eval-when-compile (require 'cl))
(defgroup org-velocity nil
@@ -99,18 +99,6 @@
:group 'org-velocity
:type 'boolean)
-(defcustom org-velocity-use-remember (featurep 'org-remember)
- "Use Org-remember or just visit the file?"
- :group 'org-velocity
- :type 'boolean)
-
-(defcustom org-velocity-remember-method 'bottom
- "Where in files should `org-remember' record new entries?"
- :group 'org-velocity
- :type '(choice (const :tag "Add at bottom" bottom)
- (const :tag "Add at top" top)
- (const :tag "Use date tree" date-tree)))
-
(defcustom org-velocity-edit-indirectly t
"Edit entries in an indirect buffer or just visit the file?"
:group 'org-velocity
@@ -124,17 +112,19 @@
(const :tag "Match any word" any)
(const :tag "Match all words" all)))
+(defcustom org-velocity-create-method 'capture
+ "Prefer `org-capture', `org-remember', or neither?"
+ :group 'org-velocity
+ :type '(choice
+ (const :tag "Prefer capture > remember > default." capture)
+ (const :tag "Prefer remember > default." remember)
+ (const :tag "Edit in buffer." buffer)))
+
(defcustom org-velocity-allow-regexps nil
"Allow searches to use regular expressions?"
:group 'org-velocity
:type 'boolean)
-(defvar org-velocity-index
- (nconc (number-sequence 49 57) ;numbers
- (number-sequence 97 122) ;lowercase letters
- (number-sequence 65 90)) ;uppercase letters
- "List of chars for indexing results.")
-
(defstruct (org-velocity-heading
(:constructor org-velocity-make-heading)
(:type list))
@@ -142,6 +132,13 @@
(name (substring-no-properties
(org-get-heading))))
+(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
+ "List of chars for indexing results.")
+
(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
@@ -212,7 +209,12 @@ If there is no last heading, return nil."
(goto-char (point-min))
(add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
(pop-to-buffer buffer)
- (message "%s" "Use C-c C-c to save changes.")))
+ (set (make-local-variable 'header-line-format)
+ (format "%s Use C-c C-c to finish."
+ (abbreviate-file-name
+ (buffer-file-name
+ (marker-buffer
+ (org-velocity-heading-marker heading))))))))
(defun org-velocity-dismiss ()
"Save current entry and close indirect buffer."
@@ -222,21 +224,14 @@ If there is no last heading, return nil."
(defun org-velocity-buttonize (heading)
"Insert HEADING as a text button."
- (insert (format "#%c " (nth (1- (line-number-at-pos)) org-velocity-index)))
- (insert-text-button
- (org-velocity-heading-name heading)
- 'action (org-velocity-make-button-action heading))
+ (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))
-(defun org-velocity-insert-heading (heading)
- "Add a new heading named HEADING."
- (with-current-buffer (org-velocity-bucket-buffer)
- (goto-char (point-max))
- (newline)
- (org-insert-heading) (insert heading)
- (newline)
- (goto-char (point-max))))
-
(defun org-velocity-remember (heading &optional region)
"Use `org-remember' to record a note to HEADING.
If there is a REGION that will be inserted."
@@ -244,14 +239,39 @@ If there is a REGION that will be inserted."
(list (list
"Velocity entry"
?v
- (let ((string "* %s\n\n%%?"))
- (if region
- (format (concat string "%s") heading region)
- (format string heading)))
+ (format "* %s\n\n%%?%s" heading (or region ""))
(org-velocity-use-file)
- org-velocity-remember-method))))
+ 'bottom))))
(org-remember nil ?v)))
+(defun org-velocity-capture (heading &optional region)
+ "Use `org-capture' to record a note to HEADING.
+If there is a REGION that will be inserted."
+ (let ((org-capture-templates
+ (list `("v"
+ "Velocity entry"
+ entry
+ (file ,(org-velocity-use-file))
+ ,(format "* %s\n\n%%?%s" heading (or region ""))))))
+ (if (fboundp 'org-capture) ;; quiet compiler
+ (org-capture nil "v"))))
+
+(defun org-velocity-insert-heading (heading)
+ "Add a new heading named HEADING."
+ (with-current-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 (search region)
+ "Add and visit a new heading named SEARCH.
+If REGION is non-nil insert as the contents of the heading."
+ (org-velocity-insert-heading search)
+ (switch-to-buffer (org-velocity-bucket-buffer))
+ (when region (insert region)))
+
(defun org-velocity-all-search (search)
"Return entries containing all words in SEARCH."
(when (file-exists-p (org-velocity-use-file))
@@ -261,20 +281,16 @@ If there is a REGION that will be inserted."
(mapcar 'org-velocity-quote
(split-string search)))
(case-fold-search t))
- (apply 'nconc
- (org-map-entries
- (lambda ()
- (let ((limit (save-excursion (org-end-of-subtree)
- (point))))
- (catch 'fail
- (mapcar
- (lambda (word)
- (or (save-excursion
- (and (re-search-forward word limit t)
- (org-velocity-nearest-heading
- (match-beginning 0))))
- (throw 'fail nil)))
- keywords)))))))))))
+ (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))))))))))
(defun org-velocity-generic-search (search)
"Return entries containing SEARCH."
@@ -301,7 +317,7 @@ If there is a REGION that will be inserted."
(defun org-velocity-present (headings)
"Buttonize HEADINGS in `org-velocity-display-buffer'."
(and (listp headings) (delete-dups headings))
- (let ((cdr (nthcdr
+ (let ((cdr (nthcdr
(1- (length org-velocity-index))
headings)))
(and (consp cdr) (setcdr cdr nil)))
@@ -311,7 +327,24 @@ If there is a REGION that will be inserted."
headings)
(goto-char (point-min))))
-(defun org-velocity-new (search &optional ask)
+(defun org-velocity-create-1 (search region)
+ "Create a new heading named SEARCH.
+If REGION is non-nil insert as contents of new heading.
+The possible methods are `org-velocity-capture',
+`org-velocity-remember', or `org-velocity-create-heading', 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))
+ (remember (or (and (featurep 'org-remember) 'org-velocity-remember)
+ 'org-velocity-create-heading))
+ (buffer 'org-velocity-create-heading))
+ search region))
+
+(defun org-velocity-create (search &optional ask)
"Create new heading named SEARCH.
If ASK is non-nil, ask first."
(if (or (null ask)
@@ -321,37 +354,45 @@ If ASK is non-nil, ask first."
(buffer-substring
(region-beginning)
(region-end)))))
- (if org-velocity-use-remember
- (org-velocity-remember search region)
- (progn
- (org-velocity-insert-heading search)
- (switch-to-buffer (org-velocity-bucket-buffer))
- (when region (insert region))))
+ (with-current-buffer (org-velocity-bucket-buffer)
+ (org-velocity-create-1 search region))
(when region (message "%s" "Inserted region"))
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)))))
+
(defun org-velocity-engine (search)
"Display a list of headings where SEARCH occurs."
- (with-current-buffer (org-velocity-display-buffer) (erase-buffer))
- (unless (string-equal "" search);exit on empty string
+ (with-current-buffer (org-velocity-display-buffer)
+ (erase-buffer)
+ (setq cursor-type nil))
+ (unless (or
+ (not (stringp search))
+ (string-equal "" search)) ;exit on empty string
(case
(with-current-buffer (org-velocity-bucket-buffer)
(save-excursion
- (let ((matches
- (case org-velocity-search-method
- ('phrase (org-velocity-phrase-search search))
- ('any (org-velocity-any-search search))
- ('all (org-velocity-all-search search)))))
+ (let ((matches (org-velocity-get-matches search)))
(org-velocity-present matches)
(cond ((zerop (length matches)) 'new)
((= (length matches) 1) 'follow)
((> (length matches) 1) 'prompt)))))
('prompt (progn
- (display-buffer (org-velocity-display-buffer))
- (case (org-velocity-follow-hint)
- ('edit (org-velocity-read nil search))
- ('new (org-velocity-new search)))))
- ('new (unless (org-velocity-new search t)
+ (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))
+ (otherwise (org-velocity-activate-button hint)))))))
+ ('new (unless (org-velocity-create search t)
(org-velocity-read nil search)))
('follow (if (y-or-n-p "One match, follow? ")
(progn
@@ -360,86 +401,104 @@ If ASK is non-nil, ask first."
(button-activate (next-button (point))))
(org-velocity-read nil search))))))
-(defun org-velocity-list-position (elt list)
- "Return first position of ELT in LIST"
- (let ((copy (copy-list list)))
- (1-
- (length
- (progn
- (setcdr (member elt copy) nil)
- copy)))))
+(defun org-velocity-position (item list)
+ "Return first position of ITEM in LIST."
+ (loop for elt in list
+ for i from 0
+ if (equal elt item)
+ return i))
(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-list-position char org-velocity-index))
+ (forward-line (org-velocity-position char org-velocity-index))
(goto-char
(button-start
(next-button (point))))
(message "%s" (button-label (button-at (point))))
(button-activate (button-at (point))))
-(defun org-velocity-follow-hint ()
- "Prompt for index of button."
- (let ((hint
- (read-key
- "Follow (0 for new note, RET to edit search, TAB to scroll): ")))
- (cond
- ;; quit?
- ((or (eq hint 7) ;C-g
- (eq hint 27)) ;ESC
- (keyboard-quit))
- ;; zero?
- ((eq hint 48)
- 'new)
- ;; return?
- ((or (eq hint 13) ;\r
- (eq hint 10)) ;\n
- 'edit)
- ;; tab?
- ((eq hint 9)
- (let ((other-window-scroll-buffer
- (org-velocity-display-buffer)))
- (scroll-other-window))
- (org-velocity-follow-hint))
- ;; click?
- ((mouse-event-p hint)
- (mouse-set-point hint)
- (if (button-at (point))
- (push-button (point))
- (org-velocity-follow-hint)))
- ;; unhandled char?
- ((not (memq hint org-velocity-index))
- (org-velocity-follow-hint))
- ;; index beyond results?
- ((> (org-velocity-list-position hint org-velocity-index)
- (with-current-buffer (org-velocity-display-buffer)
+(defun org-velocity-electric-undefined ()
+ "Complain about an undefined key."
+ (interactive)
+ (message "%s"
+ (substitute-command-keys
+ "\\[org-velocity-electric-new] for new entry, \\[org-velocity-electric-edit] to edit search, \\[scroll-up] to scroll."))
+ (sit-for 4))
+
+(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)
(1- (count-lines (point-min) (point-max)))))
- (org-velocity-follow-hint))
- ;; follow hint
- (t (set-buffer (org-velocity-display-buffer))
- (org-velocity-activate-button hint)))))
+ (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)
+ (throw 'org-velocity-select 'edit))
+
+(defun org-velocity-electric-new ()
+ "Force a new entry."
+ (interactive)
+ (throw 'org-velocity-select 'new))
+
+(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))
+ (define-key map "0" 'org-velocity-electric-new)
+ (define-key map [tab] 'scroll-up)
+ (define-key map [return] 'org-velocity-electric-edit)
+ (define-key map [mouse-1] 'org-velocity-electric-click)
+ (define-key map [mouse-2] 'org-velocity-electric-click)
+ (define-key map [escape escape escape] 'keyboard-quit)
+ (define-key map "\C-h" 'help-command)
+ map))
+
+(defun org-velocity-electric-follow-hint ()
+ "Read index of button electrically."
+ (with-current-buffer (org-velocity-display-buffer)
+ (use-local-map org-velocity-electric-map)
+ (catch 'org-velocity-select
+ (Electric-command-loop 'org-velocity-select
+ "Follow: "))))
+
+(defun org-velocity-read-with-completion (prompt)
+ "Like `completing-read' on entries with PROMPT.
+Use `minibuffer-local-filename-completion-map'."
+ (let ((minibuffer-local-completion-map
+ minibuffer-local-filename-completion-map))
+ (completing-read
+ prompt
+ (mapcar 'substring-no-properties
+ (org-map-entries 'org-get-heading)))))
(defun org-velocity-read-string (prompt &optional initial-input)
- "Read string using `read-string', with PROMPT followed by 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
+ ;; `read-from-minibuffer'), but in this case it is the user-friendly
;; thing to do.
- (let ((minibuffer-setup-hook minibuffer-setup-hook))
- (add-hook 'minibuffer-setup-hook (lambda ()
- (and initial-input (insert initial-input))
- (goto-char (point-max))))
+ (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)))
- (completing-read
- prompt
- (with-current-buffer (org-velocity-bucket-buffer)
- (org-map-entries
- (lambda ()
- (substring-no-properties
- (org-get-heading))))))
- (read-string prompt))))
+ (org-velocity-read-with-completion prompt)
+ (read-string prompt))))
(defun org-velocity-read (arg &optional search)
"Read a search string SEARCH for Org-Velocity interface.
@@ -465,5 +524,4 @@ file. Calling with ARG forces current file."
(delete-other-windows)))))
(provide 'org-velocity)
-
;;; org-velocity.el ends here
[-- Attachment #3: Type: text/plain, Size: 201 bytes --]
_______________________________________________
Emacs-orgmode mailing list
Please use `Reply All' to send replies to the list.
Emacs-orgmode@gnu.org
http://lists.gnu.org/mailman/listinfo/emacs-orgmode
^ permalink raw reply related [flat|nested] 3+ messages in thread
* Re: [PATCH] org-velocity and org-remember
2010-11-03 23:22 [PATCH] org-velocity and org-remember Paul M. Rodriguez
@ 2010-11-04 21:53 ` Jeff Horn
2010-11-15 10:23 ` [Accepted] " Carsten Dominik
1 sibling, 0 replies; 3+ messages in thread
From: Jeff Horn @ 2010-11-04 21:53 UTC (permalink / raw)
To: Paul M. Rodriguez; +Cc: emacs-orgmode
Thanks for taking care of this, Paul. The patch works fine on my end.
I seem to remember an option for inserting the note with a date tree.
Has something changed or am I confusing org-velocity options with
another set of options?
Can I get org-velocity to automatically insert a timestamp, perhaps by
giving it a default capture template to use?
Jeff
On Wed, Nov 3, 2010 at 7:22 PM, Paul M. Rodriguez
<paulmrodriguez@gmail.com> wrote:
>
> This patch supports org-capture (with fallback to org-remember) for
> org-velocity. It also effects some internal changes, principally due to
> the use of `Electric-command-loop' to replace an expedient equivalent.
>
>
> _______________________________________________
> Emacs-orgmode mailing list
> Please use `Reply All' to send replies to the list.
> Emacs-orgmode@gnu.org
> http://lists.gnu.org/mailman/listinfo/emacs-orgmode
>
>
--
Jeffrey Horn
Graduate Lecturer and PhD Student in Economics
George Mason University
(704) 271-4797
jhorn@gmu.edu
jrhorn424@gmail.com
http://www.failuretorefrain.com/jeff/
^ permalink raw reply [flat|nested] 3+ messages in thread
* [Accepted] org-velocity and org-remember
2010-11-03 23:22 [PATCH] org-velocity and org-remember Paul M. Rodriguez
2010-11-04 21:53 ` Jeff Horn
@ 2010-11-15 10:23 ` Carsten Dominik
1 sibling, 0 replies; 3+ messages in thread
From: Carsten Dominik @ 2010-11-15 10:23 UTC (permalink / raw)
To: emacs-orgmode
Patch 362 (http://patchwork.newartisans.com/patch/362/) is now "Accepted".
Maintainer comment: none
This relates to the following submission:
http://mid.gmane.org/%3C87mxpqc7rr.fsf%40gmail.com%3E
Here is the original message containing the patch:
> Content-Type: text/plain; charset="utf-8"
> MIME-Version: 1.0
> Content-Transfer-Encoding: 7bit
> Subject: [Orgmode] org-velocity and org-remember
> Date: Thu, 04 Nov 2010 04:22:16 -0000
> From: Paul M. Rodriguez <paulmrodriguez@gmail.com>
> X-Patchwork-Id: 362
> Message-Id: <87mxpqc7rr.fsf@gmail.com>
> To: emacs-orgmode@gnu.org
>
> This patch supports org-capture (with fallback to org-remember) for
> org-velocity. It also effects some internal changes, principally due to
> the use of `Electric-command-loop' to replace an expedient equivalent.
>
>
> diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el
> index 3e7453b..2a1f41b 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: 2.1
> +;; Version: 2.2
>
> ;; This file is not part of GNU Emacs.
>
> @@ -59,23 +59,23 @@
> ;; 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. When
> -;; org-remember is loaded, or the user customizes
> -;; `org-velocity-use-remember', then org-remember is used to insert
> -;; the new heading. Otherwise the user is simply taken to a new
> -;; heading at the end of the file.
> +;; 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.
>
> ;; Thanks to Richard Riley, Carsten Dominik, and Bastien Guerry for
> ;; their suggestions.
>
> ;;; Usage:
> -;;; (require 'org-velocity)
> -;;; (setq org-velocity-bucket (concat org-directory "/bucket.org"))
> -;;; (global-set-key (kbd "C-c v") 'org-velocity-read)
> +;; (require 'org-velocity)
> +;; (setq org-velocity-bucket (concat org-directory "/bucket.org"))
> +;; (global-set-key (kbd "C-c v") 'org-velocity-read)
>
> ;;; Code:
> (require 'org)
> (require 'button)
> +(require 'electric)
> (eval-when-compile (require 'cl))
>
> (defgroup org-velocity nil
> @@ -99,18 +99,6 @@
> :group 'org-velocity
> :type 'boolean)
>
> -(defcustom org-velocity-use-remember (featurep 'org-remember)
> - "Use Org-remember or just visit the file?"
> - :group 'org-velocity
> - :type 'boolean)
> -
> -(defcustom org-velocity-remember-method 'bottom
> - "Where in files should `org-remember' record new entries?"
> - :group 'org-velocity
> - :type '(choice (const :tag "Add at bottom" bottom)
> - (const :tag "Add at top" top)
> - (const :tag "Use date tree" date-tree)))
> -
> (defcustom org-velocity-edit-indirectly t
> "Edit entries in an indirect buffer or just visit the file?"
> :group 'org-velocity
> @@ -124,17 +112,19 @@
> (const :tag "Match any word" any)
> (const :tag "Match all words" all)))
>
> +(defcustom org-velocity-create-method 'capture
> + "Prefer `org-capture', `org-remember', or neither?"
> + :group 'org-velocity
> + :type '(choice
> + (const :tag "Prefer capture > remember > default." capture)
> + (const :tag "Prefer remember > default." remember)
> + (const :tag "Edit in buffer." buffer)))
> +
> (defcustom org-velocity-allow-regexps nil
> "Allow searches to use regular expressions?"
> :group 'org-velocity
> :type 'boolean)
>
> -(defvar org-velocity-index
> - (nconc (number-sequence 49 57) ;numbers
> - (number-sequence 97 122) ;lowercase letters
> - (number-sequence 65 90)) ;uppercase letters
> - "List of chars for indexing results.")
> -
> (defstruct (org-velocity-heading
> (:constructor org-velocity-make-heading)
> (:type list))
> @@ -142,6 +132,13 @@
> (name (substring-no-properties
> (org-get-heading))))
>
> +(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
> + "List of chars for indexing results.")
> +
> (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
> @@ -212,7 +209,12 @@ If there is no last heading, return nil."
> (goto-char (point-min))
> (add-hook 'org-ctrl-c-ctrl-c-hook 'org-velocity-dismiss nil t))
> (pop-to-buffer buffer)
> - (message "%s" "Use C-c C-c to save changes.")))
> + (set (make-local-variable 'header-line-format)
> + (format "%s Use C-c C-c to finish."
> + (abbreviate-file-name
> + (buffer-file-name
> + (marker-buffer
> + (org-velocity-heading-marker heading))))))))
>
> (defun org-velocity-dismiss ()
> "Save current entry and close indirect buffer."
> @@ -222,21 +224,14 @@ If there is no last heading, return nil."
>
> (defun org-velocity-buttonize (heading)
> "Insert HEADING as a text button."
> - (insert (format "#%c " (nth (1- (line-number-at-pos)) org-velocity-index)))
> - (insert-text-button
> - (org-velocity-heading-name heading)
> - 'action (org-velocity-make-button-action heading))
> + (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))
>
> -(defun org-velocity-insert-heading (heading)
> - "Add a new heading named HEADING."
> - (with-current-buffer (org-velocity-bucket-buffer)
> - (goto-char (point-max))
> - (newline)
> - (org-insert-heading) (insert heading)
> - (newline)
> - (goto-char (point-max))))
> -
> (defun org-velocity-remember (heading &optional region)
> "Use `org-remember' to record a note to HEADING.
> If there is a REGION that will be inserted."
> @@ -244,14 +239,39 @@ If there is a REGION that will be inserted."
> (list (list
> "Velocity entry"
> ?v
> - (let ((string "* %s\n\n%%?"))
> - (if region
> - (format (concat string "%s") heading region)
> - (format string heading)))
> + (format "* %s\n\n%%?%s" heading (or region ""))
> (org-velocity-use-file)
> - org-velocity-remember-method))))
> + 'bottom))))
> (org-remember nil ?v)))
>
> +(defun org-velocity-capture (heading &optional region)
> + "Use `org-capture' to record a note to HEADING.
> +If there is a REGION that will be inserted."
> + (let ((org-capture-templates
> + (list `("v"
> + "Velocity entry"
> + entry
> + (file ,(org-velocity-use-file))
> + ,(format "* %s\n\n%%?%s" heading (or region ""))))))
> + (if (fboundp 'org-capture) ;; quiet compiler
> + (org-capture nil "v"))))
> +
> +(defun org-velocity-insert-heading (heading)
> + "Add a new heading named HEADING."
> + (with-current-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 (search region)
> + "Add and visit a new heading named SEARCH.
> +If REGION is non-nil insert as the contents of the heading."
> + (org-velocity-insert-heading search)
> + (switch-to-buffer (org-velocity-bucket-buffer))
> + (when region (insert region)))
> +
> (defun org-velocity-all-search (search)
> "Return entries containing all words in SEARCH."
> (when (file-exists-p (org-velocity-use-file))
> @@ -261,20 +281,16 @@ If there is a REGION that will be inserted."
> (mapcar 'org-velocity-quote
> (split-string search)))
> (case-fold-search t))
> - (apply 'nconc
> - (org-map-entries
> - (lambda ()
> - (let ((limit (save-excursion (org-end-of-subtree)
> - (point))))
> - (catch 'fail
> - (mapcar
> - (lambda (word)
> - (or (save-excursion
> - (and (re-search-forward word limit t)
> - (org-velocity-nearest-heading
> - (match-beginning 0))))
> - (throw 'fail nil)))
> - keywords)))))))))))
> + (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))))))))))
>
> (defun org-velocity-generic-search (search)
> "Return entries containing SEARCH."
> @@ -301,7 +317,7 @@ If there is a REGION that will be inserted."
> (defun org-velocity-present (headings)
> "Buttonize HEADINGS in `org-velocity-display-buffer'."
> (and (listp headings) (delete-dups headings))
> - (let ((cdr (nthcdr
> + (let ((cdr (nthcdr
> (1- (length org-velocity-index))
> headings)))
> (and (consp cdr) (setcdr cdr nil)))
> @@ -311,7 +327,24 @@ If there is a REGION that will be inserted."
> headings)
> (goto-char (point-min))))
>
> -(defun org-velocity-new (search &optional ask)
> +(defun org-velocity-create-1 (search region)
> + "Create a new heading named SEARCH.
> +If REGION is non-nil insert as contents of new heading.
> +The possible methods are `org-velocity-capture',
> +`org-velocity-remember', or `org-velocity-create-heading', 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))
> + (remember (or (and (featurep 'org-remember) 'org-velocity-remember)
> + 'org-velocity-create-heading))
> + (buffer 'org-velocity-create-heading))
> + search region))
> +
> +(defun org-velocity-create (search &optional ask)
> "Create new heading named SEARCH.
> If ASK is non-nil, ask first."
> (if (or (null ask)
> @@ -321,37 +354,45 @@ If ASK is non-nil, ask first."
> (buffer-substring
> (region-beginning)
> (region-end)))))
> - (if org-velocity-use-remember
> - (org-velocity-remember search region)
> - (progn
> - (org-velocity-insert-heading search)
> - (switch-to-buffer (org-velocity-bucket-buffer))
> - (when region (insert region))))
> + (with-current-buffer (org-velocity-bucket-buffer)
> + (org-velocity-create-1 search region))
> (when region (message "%s" "Inserted region"))
> 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)))))
> +
> (defun org-velocity-engine (search)
> "Display a list of headings where SEARCH occurs."
> - (with-current-buffer (org-velocity-display-buffer) (erase-buffer))
> - (unless (string-equal "" search);exit on empty string
> + (with-current-buffer (org-velocity-display-buffer)
> + (erase-buffer)
> + (setq cursor-type nil))
> + (unless (or
> + (not (stringp search))
> + (string-equal "" search)) ;exit on empty string
> (case
> (with-current-buffer (org-velocity-bucket-buffer)
> (save-excursion
> - (let ((matches
> - (case org-velocity-search-method
> - ('phrase (org-velocity-phrase-search search))
> - ('any (org-velocity-any-search search))
> - ('all (org-velocity-all-search search)))))
> + (let ((matches (org-velocity-get-matches search)))
> (org-velocity-present matches)
> (cond ((zerop (length matches)) 'new)
> ((= (length matches) 1) 'follow)
> ((> (length matches) 1) 'prompt)))))
> ('prompt (progn
> - (display-buffer (org-velocity-display-buffer))
> - (case (org-velocity-follow-hint)
> - ('edit (org-velocity-read nil search))
> - ('new (org-velocity-new search)))))
> - ('new (unless (org-velocity-new search t)
> + (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))
> + (otherwise (org-velocity-activate-button hint)))))))
> + ('new (unless (org-velocity-create search t)
> (org-velocity-read nil search)))
> ('follow (if (y-or-n-p "One match, follow? ")
> (progn
> @@ -360,86 +401,104 @@ If ASK is non-nil, ask first."
> (button-activate (next-button (point))))
> (org-velocity-read nil search))))))
>
> -(defun org-velocity-list-position (elt list)
> - "Return first position of ELT in LIST"
> - (let ((copy (copy-list list)))
> - (1-
> - (length
> - (progn
> - (setcdr (member elt copy) nil)
> - copy)))))
> +(defun org-velocity-position (item list)
> + "Return first position of ITEM in LIST."
> + (loop for elt in list
> + for i from 0
> + if (equal elt item)
> + return i))
>
> (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-list-position char org-velocity-index))
> + (forward-line (org-velocity-position char org-velocity-index))
> (goto-char
> (button-start
> (next-button (point))))
> (message "%s" (button-label (button-at (point))))
> (button-activate (button-at (point))))
>
> -(defun org-velocity-follow-hint ()
> - "Prompt for index of button."
> - (let ((hint
> - (read-key
> - "Follow (0 for new note, RET to edit search, TAB to scroll): ")))
> - (cond
> - ;; quit?
> - ((or (eq hint 7) ;C-g
> - (eq hint 27)) ;ESC
> - (keyboard-quit))
> - ;; zero?
> - ((eq hint 48)
> - 'new)
> - ;; return?
> - ((or (eq hint 13) ;\r
> - (eq hint 10)) ;\n
> - 'edit)
> - ;; tab?
> - ((eq hint 9)
> - (let ((other-window-scroll-buffer
> - (org-velocity-display-buffer)))
> - (scroll-other-window))
> - (org-velocity-follow-hint))
> - ;; click?
> - ((mouse-event-p hint)
> - (mouse-set-point hint)
> - (if (button-at (point))
> - (push-button (point))
> - (org-velocity-follow-hint)))
> - ;; unhandled char?
> - ((not (memq hint org-velocity-index))
> - (org-velocity-follow-hint))
> - ;; index beyond results?
> - ((> (org-velocity-list-position hint org-velocity-index)
> - (with-current-buffer (org-velocity-display-buffer)
> +(defun org-velocity-electric-undefined ()
> + "Complain about an undefined key."
> + (interactive)
> + (message "%s"
> + (substitute-command-keys
> + "\\[org-velocity-electric-new] for new entry, \\[org-velocity-electric-edit] to edit search, \\[scroll-up] to scroll."))
> + (sit-for 4))
> +
> +(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)
> (1- (count-lines (point-min) (point-max)))))
> - (org-velocity-follow-hint))
> - ;; follow hint
> - (t (set-buffer (org-velocity-display-buffer))
> - (org-velocity-activate-button hint)))))
> + (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)
> + (throw 'org-velocity-select 'edit))
> +
> +(defun org-velocity-electric-new ()
> + "Force a new entry."
> + (interactive)
> + (throw 'org-velocity-select 'new))
> +
> +(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))
> + (define-key map "0" 'org-velocity-electric-new)
> + (define-key map [tab] 'scroll-up)
> + (define-key map [return] 'org-velocity-electric-edit)
> + (define-key map [mouse-1] 'org-velocity-electric-click)
> + (define-key map [mouse-2] 'org-velocity-electric-click)
> + (define-key map [escape escape escape] 'keyboard-quit)
> + (define-key map "\C-h" 'help-command)
> + map))
> +
> +(defun org-velocity-electric-follow-hint ()
> + "Read index of button electrically."
> + (with-current-buffer (org-velocity-display-buffer)
> + (use-local-map org-velocity-electric-map)
> + (catch 'org-velocity-select
> + (Electric-command-loop 'org-velocity-select
> + "Follow: "))))
> +
> +(defun org-velocity-read-with-completion (prompt)
> + "Like `completing-read' on entries with PROMPT.
> +Use `minibuffer-local-filename-completion-map'."
> + (let ((minibuffer-local-completion-map
> + minibuffer-local-filename-completion-map))
> + (completing-read
> + prompt
> + (mapcar 'substring-no-properties
> + (org-map-entries 'org-get-heading)))))
>
> (defun org-velocity-read-string (prompt &optional initial-input)
> - "Read string using `read-string', with PROMPT followed by 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
> + ;; `read-from-minibuffer'), but in this case it is the user-friendly
> ;; thing to do.
> - (let ((minibuffer-setup-hook minibuffer-setup-hook))
> - (add-hook 'minibuffer-setup-hook (lambda ()
> - (and initial-input (insert initial-input))
> - (goto-char (point-max))))
> + (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)))
> - (completing-read
> - prompt
> - (with-current-buffer (org-velocity-bucket-buffer)
> - (org-map-entries
> - (lambda ()
> - (substring-no-properties
> - (org-get-heading))))))
> - (read-string prompt))))
> + (org-velocity-read-with-completion prompt)
> + (read-string prompt))))
>
> (defun org-velocity-read (arg &optional search)
> "Read a search string SEARCH for Org-Velocity interface.
> @@ -465,5 +524,4 @@ file. Calling with ARG forces current file."
> (delete-other-windows)))))
>
> (provide 'org-velocity)
> -
> ;;; org-velocity.el ends here
>
^ permalink raw reply [flat|nested] 3+ messages in thread
end of thread, other threads:[~2010-11-15 10:23 UTC | newest]
Thread overview: 3+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2010-11-03 23:22 [PATCH] org-velocity and org-remember Paul M. Rodriguez
2010-11-04 21:53 ` Jeff Horn
2010-11-15 10:23 ` [Accepted] " Carsten Dominik
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).