diff --git a/contrib/README b/contrib/README index f8fe4233f..3cb076d0e 100644 --- a/contrib/README +++ b/contrib/README @@ -43,6 +43,7 @@ org-special-blocks.el --- Turn blocks into LaTeX envs and HTML divs orgtbl-sqlinsert.el --- Convert Org-mode tables to SQL insertions org-toc.el --- Table of contents for Org-mode buffer org-track.el --- Keep up with Org development +org-velocity.el --- something like Notational Velocity for Org diff --git a/contrib/lisp/org-velocity.el b/contrib/lisp/org-velocity.el new file mode 100644 index 000000000..3e7453be2 --- /dev/null +++ b/contrib/lisp/org-velocity.el @@ -0,0 +1,469 @@ +;;; org-velocity.el --- something like Notational Velocity for Org. + +;; Copyright (C) 2010 Paul M. Rodriguez + +;; Author: Paul M. Rodriguez +;; Created: 2010-05-05 +;; Version: 2.1 + +;; This file is not part of GNU Emacs. + +;; This program is free software; you can redistribute it and/or +;; modify it under the terms of the GNU General Public License as +;; published by the Free Software Foundation version 2. + +;; This program is distributed in the hope that it will be useful, but +;; WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;; General Public License for more details. + +;; For a copy of the GNU General Public License, search the Internet, +;; or write to the Free Software Foundation, Inc., 59 Temple Place, +;; 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. 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. + +;; 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) + +;;; Code: +(require 'org) +(require 'button) +(eval-when-compile (require 'cl)) + +(defgroup org-velocity nil + "Notational Velocity-style interface for Org." + :tag "Org-Velocity" + :group 'outlines + :group 'hypermedia) + +(defcustom org-velocity-bucket "" + "Where is the bucket file?" + :group 'org-velocity + :type 'file) + +(defcustom org-velocity-always-use-bucket nil + "Use bucket file even when called from an Org buffer?" + :group 'org-velocity + :type 'boolean) + +(defcustom org-velocity-use-completion nil + "Complete on heading names?" + :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 + :type 'boolean) + +(defcustom org-velocity-search-method 'phrase + "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))) + +(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)) + (marker (point-marker)) + (name (substring-no-properties + (org-get-heading)))) + +(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." + (let ((org-velocity-bucket + (and org-velocity-bucket (expand-file-name org-velocity-bucket)))) + (if org-velocity-always-use-bucket + (or org-velocity-bucket (error "Bucket required but not defined")) + (if (and (eq major-mode 'org-mode) + (buffer-file-name)) + (buffer-file-name) + (or org-velocity-bucket + (error "No bucket and not an Org file")))))) + +(defsubst org-velocity-display-buffer () + "Return the proper buffer for Org-Velocity to display in." + (get-buffer-create "*Velocity headings*")) + +(defsubst org-velocity-bucket-buffer () + "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)))) + +(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))))))) + +(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))))) + (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) + (point))) + (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."))) + +(defun org-velocity-dismiss () + "Save current entry and close indirect buffer." + (progn + (save-buffer) + (kill-buffer))) + +(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)) + (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." + (let ((org-remember-templates + (list (list + "Velocity entry" + ?v + (let ((string "* %s\n\n%%?")) + (if region + (format (concat string "%s") heading region) + (format string heading))) + (org-velocity-use-file) + org-velocity-remember-method)))) + (org-remember nil ?v))) + +(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)) + (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))))))))))) + +(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))))) + +(defsubst org-velocity-phrase-search (search) + "Return entries containing SEARCH as a phrase." + (org-velocity-generic-search (org-velocity-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)))) + +(defun org-velocity-present (headings) + "Buttonize HEADINGS in `org-velocity-display-buffer'." + (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)))) + +(defun org-velocity-new (search &optional ask) + "Create new heading named SEARCH. +If ASK is non-nil, ask first." + (if (or (null ask) + (y-or-n-p "No match found, create? ")) + ;; if there's a region, we want to insert it + (let ((region (if (use-region-p) + (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)))) + (when region (message "%s" "Inserted region")) + 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 + (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))))) + (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) + (org-velocity-read nil search))) + ('follow (if (y-or-n-p "One match, follow? ") + (progn + (set-buffer (org-velocity-display-buffer)) + (goto-char (point-min)) + (button-activate (next-button (point)))) + (org-velocity-read nil search)))))) + +(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-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)) + (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) + (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))))) + +(defun org-velocity-read-string (prompt &optional initial-input) + "Read string using `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. + (let ((minibuffer-setup-hook minibuffer-setup-hook)) + (add-hook 'minibuffer-setup-hook (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)))) + +(defun org-velocity-read (arg &optional search) + "Read a search string SEARCH for Org-Velocity interface. +This means that a buffer will display all headings where SEARCH +occurs, where one can be selected by a mouse click or by typing +its index. If SEARCH does not occur, then a new heading may be +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." + (interactive "P") + (let ((org-velocity-always-use-bucket + (if arg nil org-velocity-always-use-bucket))) + ;; complain if inappropriate + (assert (org-velocity-use-file)) + (unwind-protect + (org-velocity-engine + (org-velocity-read-string "Velocity search: " search)) + (progn + (kill-buffer (org-velocity-display-buffer)) + (delete-other-windows))))) + +(provide 'org-velocity) + +;;; org-velocity.el ends here diff --git a/lisp/org.el b/lisp/org.el index 2ad7ce11c..e2bf72749 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -295,6 +295,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag " wl: Links to Wanderlust folders/messages" org-wl) (const :tag " w3m: Special cut/paste from w3m to Org-mode." org-w3m) (const :tag " mouse: Additional mouse support" org-mouse) + (const :tag " TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) (const :tag "C annotate-file: Annotate a file with org syntax" org-annotate-file) (const :tag "C bookmark: Org-mode links to bookmarks" org-bookmark) @@ -328,7 +329,7 @@ to add the symbol `xyz', and the package must have a call to (const :tag "C sqlinsert: Convert Org-mode tables to SQL insertions" orgtbl-sqlinsert) (const :tag "C toc: Table of contents for Org-mode buffer" org-toc) (const :tag "C track: Keep up with Org-mode development" org-track) - (const :tag "C TaskJuggler: Export tasks to a TaskJuggler project" org-taskjuggler) + (const :tag "C velocity Something like Notational Velocity for Org" org-velocity) (repeat :tag "External packages" :inline t (symbol :tag "Package")))) (defcustom org-support-shift-select nil