summaryrefslogtreecommitdiff
path: root/.emacs.d/org-7.4/contrib/lisp/org-velocity.el
diff options
context:
space:
mode:
authorLuke Shumaker <LukeShu@sbcglobal.net>2011-05-17 16:27:50 -0400
committerLuke Shumaker <LukeShu@sbcglobal.net>2011-05-17 16:27:50 -0400
commitb81536ad49001abf292bd31a0dcbf57e387387b1 (patch)
tree722cac2e9eab46a3b18d930dcd37703df48ebeba /.emacs.d/org-7.4/contrib/lisp/org-velocity.el
parent5b8794f1f5e82c1a220f36a724e5c8ce3335c462 (diff)
Fiddle with emacs config (when to use -n, -c), get emacs using el-get.
Diffstat (limited to '.emacs.d/org-7.4/contrib/lisp/org-velocity.el')
-rw-r--r--.emacs.d/org-7.4/contrib/lisp/org-velocity.el527
1 files changed, 0 insertions, 527 deletions
diff --git a/.emacs.d/org-7.4/contrib/lisp/org-velocity.el b/.emacs.d/org-7.4/contrib/lisp/org-velocity.el
deleted file mode 100644
index 2a1f41b..0000000
--- a/.emacs.d/org-7.4/contrib/lisp/org-velocity.el
+++ /dev/null
@@ -1,527 +0,0 @@
-;;; org-velocity.el --- something like Notational Velocity for Org.
-
-;; Copyright (C) 2010 Paul M. Rodriguez
-
-;; Author: Paul M. Rodriguez <paulmrodriguez@gmail.com>
-;; Created: 2010-05-05
-;; Version: 2.2
-
-;; 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. 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)
-
-;;; Code:
-(require 'org)
-(require 'button)
-(require 'electric)
-(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-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-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)
-
-(defstruct (org-velocity-heading
- (:constructor org-velocity-make-heading)
- (:type list))
- (marker (point-marker))
- (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
-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)
- (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."
- (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)))
- (let ((action (org-velocity-make-button-action heading)))
- (insert-text-button
- (org-velocity-heading-name heading)
- 'action action))
- (newline))
-
-(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
- (format "* %s\n\n%%?%s" heading (or region ""))
- (org-velocity-use-file)
- '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))
- (save-excursion
- (delq nil
- (let ((keywords
- (mapcar 'org-velocity-quote
- (split-string search)))
- (case-fold-search t))
- (org-map-entries
- (lambda ()
- (if (loop with limit = (save-excursion
- (org-end-of-subtree)
- (point))
- for word in keywords
- always (save-excursion
- (re-search-forward word limit t)))
- (org-velocity-nearest-heading
- (match-beginning 0))))))))))
-
-(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-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)
- (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)))))
- (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)
- (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 (org-velocity-get-matches search)))
- (org-velocity-present matches)
- (cond ((zerop (length matches)) 'new)
- ((= (length matches) 1) 'follow)
- ((> (length matches) 1) 'prompt)))))
- ('prompt (progn
- (Electric-pop-up-window (org-velocity-display-buffer))
- (let ((hint (org-velocity-electric-follow-hint)))
- (if hint
- (case hint
- (edit (org-velocity-read nil search))
- (new (org-velocity-create search))
- (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
- (set-buffer (org-velocity-display-buffer))
- (goto-char (point-min))
- (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
- 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-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-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)))))
- (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 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
- (lexical-let ((initial-input initial-input))
- (lambda ()
- (and initial-input (insert initial-input))
- (goto-char (point-max))))
- (if (and org-velocity-use-completion
- ;; map-entries complains for nonexistent files
- (file-exists-p (org-velocity-use-file)))
- (org-velocity-read-with-completion prompt)
- (read-string prompt))))
-
-(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