Browse Source

New capture system org-capture

* lisp/org-agenda.el (org-agenda-action): Make `c' key call org-capture.
* lisp/org-capture.el: New file.
* lisp/org-compat.el (org-get-x-clipboard): Function moved here from
remember.el.
* lisp/org-mks.el: New file
* lisp/org.el (org-set-regexps-and-options): Allow statistic cookies as
part of complex headlines.
(org-find-olp): New argument THIS-BUFFER.  When set, assume that the
OLP does not contain a file name.
Carsten Dominik 15 years ago
parent
commit
1d52e54efd
8 changed files with 1273 additions and 15 deletions
  1. 2 2
      doc/org.texi
  2. 2 0
      lisp/org-agenda.el
  3. 1126 0
      lisp/org-capture.el
  4. 6 0
      lisp/org-compat.el
  5. 2 2
      lisp/org-datetree.el
  6. 123 0
      lisp/org-mks.el
  7. 0 6
      lisp/org-remember.el
  8. 12 5
      lisp/org.el

+ 2 - 2
doc/org.texi

@@ -5953,8 +5953,8 @@ as level 1 entries to the beginning or end of the file, respectively.  It may
 also be the symbol @code{date-tree}.  Then, a tree with year on level 1,
 also be the symbol @code{date-tree}.  Then, a tree with year on level 1,
 month on level 2 and day on level three will be built in the file, and the
 month on level 2 and day on level three will be built in the file, and the
 entry will be filed into the tree under the current date@footnote{If the file
 entry will be filed into the tree under the current date@footnote{If the file
-contains an entry with a @code{DATE_TREE} property, the entire date tree will
-be built under that entry.}
+contains an entry with a @code{DATE_TREE} property (arbitrary value), the
+entire date tree will be built under that entry.}
 
 
 An optional sixth element specifies the contexts in which the user can select
 An optional sixth element specifies the contexts in which the user can select
 the template.  This element can be a list of major modes or a function.
 the template.  This element can be a list of major modes or a function.

+ 2 - 0
lisp/org-agenda.el

@@ -6991,6 +6991,8 @@ The cursor may be at a date in the calendar, or in the Org agenda."
       (org-agenda-do-action '(org-deadline nil org-overriding-default-time)))
       (org-agenda-do-action '(org-deadline nil org-overriding-default-time)))
      ((equal ans ?r)
      ((equal ans ?r)
       (org-agenda-do-action '(org-remember) t))
       (org-agenda-do-action '(org-remember) t))
+     ((equal ans ?c)
+      (org-agenda-do-action '(org-capture) t))
      ((equal ans ?\ )
      ((equal ans ?\ )
       (let ((cw (selected-window)))
       (let ((cw (selected-window)))
 	(org-switch-to-buffer-other-window
 	(org-switch-to-buffer-other-window

+ 1126 - 0
lisp/org-capture.el

@@ -0,0 +1,1126 @@
+;;; org-capture.el --- Fast note taking in Org-mode
+
+;; Copyright (C) 2010  Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.36trans
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;; Commentary:
+
+;; This file contains an alternaive implementation of the same functionality
+;; that is also provided by org-remember.el.  The implementation is more
+;; streamlined, can produce more target types (e.g. plain list items or
+;; table lines).  Also, it does not use a temporary buffer for editing
+;; the captured entry - instead it uses an indirect buffer that visits
+;; the new entry already in the target buffer (this was an idea by Samuel
+;; Wales).  John Wiegley's excellent `remember.el' is not needed for this
+;; implementation, even though we borrow heavily from its ideas.
+
+;; This implementation heavily draws on ideas by James TD Smith and
+;; Samuel Wales, and, of cause, uses John Wiegley's remember.el as inspiration.
+
+;;; TODO
+
+;; - find a clever way to not always insert an annotation maybe a
+;;   predicate function that can check for conditions for %a to be
+;;   used.  This could be one of the properties.
+
+;; - Should there be plist members that arrange for properties to be
+;;   asked for, like James proposed in his RFC?
+
+;;; Code:
+
+(eval-when-compile
+  (require 'cl))
+(require 'org)
+(require 'org-mks)
+
+(defvar org-capture-clock-was-started nil
+  "Internal flag, noting if the clock was started.")
+
+(defvar org-capture-last-stored-marker (make-marker)
+  "Marker pointing to the entry most recently stored with `org-capture'.")
+
+(defgroup org-capture nil
+  "Options concerning capturing new entries."
+  :tag "Org Capture"
+  :group 'org)
+
+(defcustom org-capture-templates nil
+  "Templates for the creation of new entries.
+
+Each entry is a list with the following items:
+
+keys         The keys that will select the template, as a string, characters
+             only, for example \"a\" for a template to be selected with a
+             single key, or \"bt\" for selection with two keys.  When using
+             several keys, keys using the same prefix key must be together
+             in the list and preceded by a 2-element entry explaining the
+             prefix key, for example
+
+                     (\"b\" \"Templates for marking stuff to buy\")
+
+             Do not use \"C\" as a key, it is reserved for customizing the
+             template variable.
+
+description  A short string describing the template, will be shown during
+             selection.
+
+type         The type of entry.  Valid are:
+               entry       an Org-mode node, with a headline. Will be
+                           filed as the child of the target entry or as
+                           a top-level entry.
+               item        a plain list item, placed in the first plain
+                           list a the target location.
+               checkitem   a checkbox item.  This only differs from the
+                           plain lis item by the default template.
+               table-line  a new line in the first table at target location.
+               plain       text to be inserted as it is.
+
+target       Specification of where the captured item should be placed.
+             In Org-mode files, targets usually define a node.  Entries will
+             become children of this node, other types will be added to the
+             table or list in the body of this node.
+
+             Valid values are:
+
+             (file \"path/to/file\")
+                 Text will be placed at the beginning or end of that file
+
+             (id \"id of existing org entry\")
+                 Filing as child of this entry, or in the body of the entry
+
+             (file+headline \"path/to/file\" \"node headline\")
+                 Fast configuration if the target heading is unique in the file
+
+             (file+olp \"path/to/file\" \"Level 1 heading\" \"Level 2\" ...)
+                 For non-unique headings, the full path is safer
+
+             (file+regexp  \"path/to/file\" \"regexp to find location\")
+
+             (file+datetree \"path/to/file\")
+                 Will create a heading in a date tree.
+
+             (file+function \"path/to/file\" function-finding-location)
+                 A function to find the right location in the file.
+
+             (clock)
+                File to the entry that is currently being clocked.
+
+             (function function-finding-location)
+                Most general way, write your own function to find both
+                file and location.
+
+
+template     The template for creating the capture item.  If you leave this
+             empty, an appropriate default template will be used.  See below
+             for more details.
+
+The rest of the entry is a property list of additional options.  Recognized
+properties are:
+
+ :prepend            Normally new captured information will be appended at
+                     the target location (last child, last table line,
+                     last list item...).  Setting this property will
+                     change that.
+
+ :immediate-finish   When set, do not offer to edit the information, just
+                     file it away immediately.  This makes sense if the
+                     template only needs information that can be added
+                     automatically.
+
+ :empty-lines        Set this to the number of lines the should be inserted
+                     before and after the new item.  Default 0, only common
+                     other value is 1.
+
+ :clock-in           Start the clock in this item.
+
+ :clock-resume       Start the interrupted clock when finishing the capture.
+
+ :unnarrowed         Do not narrow the target buffer, simply show the
+                     full buffer.  Default is to narrow it so that you
+                     only see the new stuff.
+
+The template defined the text to be inserted.  Often then this is an org-mode
+entry (so the first line should start with a star) that will be filed as a
+child of the target headline.  It can also be freely formatted text.
+Furthermore, the following %-escapes will be replaced with content:
+
+  %^{prompt}  Prompt the user for a string and replace this sequence with it.
+              A default value and a completion table ca be specified like this:
+              %^{prompt|default|completion2|completion3|...}
+  %t          time stamp, date only
+  %T          time stamp with date and time
+  %u, %U      like the above, but inactive time stamps
+  %^t         like %t, but prompt for date.  Similarly %^T, %^u, %^U.
+              You may define a prompt like %^{Please specify birthday
+  %n          user name (taken from `user-full-name')
+  %a          annotation, normally the link created with `org-store-link'
+  %i          initial content, copied from the active region.  If %i is
+              indented, the entire inserted text will be indented as well.
+  %c          current kill ring head
+  %x          content of the X clipboard
+  %^C         Interactive selection of which kill or clip to use
+  %^L         Like %^C, but insert as link
+  %k          title of currently clocked task
+  %K          link to currently clocked task
+  %^g         prompt for tags, with completion on tags in target file
+  %^G         prompt for tags, with completion all tags in all agenda files
+  %^{prop}p   Prompt the user for a value for property `prop'
+  %:keyword   specific information for certain link types, see below
+  %[pathname] insert the contents of the file given by `pathname'
+  %(sexp)     evaluate elisp `(sexp)' and replace with the result
+
+  %?          After completing the template, position cursor here.
+
+Apart from these general escapes, you can access information specific to the
+link type that is created.  For example, calling `org-capture' in emails
+or gnus will record the author and the subject of the message, which you
+can access with \"%:author\" and \"%:subject\", respectively.  Here is a
+complete list of what is recorded for each link type.
+
+Link type          |  Available information
+-------------------+------------------------------------------------------
+bbdb               |  %:type %:name %:company
+vm, wl, mh, rmail  |  %:type %:subject %:message-id
+                   |  %:from %:fromname %:fromaddress
+                   |  %:to   %:toname   %:toaddress
+                   |  %:fromto (either \"to NAME\" or \"from NAME\")
+gnus               |  %:group, for messages also all email fields
+w3, w3m            |  %:type %:url
+info               |  %:type %:file %:node
+calendar           |  %:type %:date"
+  :group 'org-capture
+  :type
+  '(repeat
+    (choice :value ("" "" entry (file "~/org/notes.org") "")
+     (list :tag "Multikey description"
+	   (string :tag "Keys       ")
+	   (string :tag "Description"))
+     (list :tag "Template entry"
+	   (string :tag "Keys           ")
+	   (string :tag "Description    ")
+	   (choice :tag "Capture Type   " :value entry
+		   (const :tag "Org entry" entry)
+		   (const :tag "Plain list item" item)
+		   (const :tag "Checkbox item" checkitem)
+		   (const :tag "Plain text" plain)
+		   (const :tag "Table line" table-line))
+	   (choice :tag "Target location"
+		   (list :tag "File"
+			 (const :format "" file)
+			 (file :tag "  File"))
+		   (list :tag "ID"
+			 (const :format "" id)
+			 (string :tag "  ID"))
+		   (list :tag "File & Headline"
+			 (const :format "" file+headline)
+			 (file   :tag "  File    ")
+			 (string :tag "  Headline"))
+		   (list :tag "File & Outline path"
+			 (const :format "" file+olp)
+			 (file   :tag "  File    ")
+			 (repeat :tag "Outline path" :inline t
+				 (string :tag "Headline")))
+		   (list :tag "File & Regexp"
+			 (const :format "" file+regexp)
+			 (file   :tag "  File  ")
+			 (regexp :tag "  Regexp"))
+		   (list :tag "File & Date tree"
+			 (const :format "" file+datetree)
+			 (file :tag "  File"))
+		   (list :tag "File & function"
+			 (const :format "" file+function)
+			 (file :tag "  File    ")
+			 (sexp :tag "  Function"))
+		   (list :tag "Current clocking task"
+			 (const :format "" clock))
+		   (list :tag "Function"
+			 (const :format "" function)
+			 (sexp :tag "  Function")))
+	   (string :tag "Template (opt) ")
+	   (plist :inline t
+		  ;; Give the most common options as checkboxes
+		  :options (((const :format "%v " :prepend) (const t))
+			    ((const :format "%v " :immediate-finish) (const t))
+			    ((const :format "%v " :empty-lines) (const 1))
+			    ((const :format "%v " :clock-in) (const t))
+			    ((const :format "%v " :clock-resume) (const t))
+			    ((const :format "%v " :unnarrowed) (const t))))))))
+
+(defcustom org-capture-before-finalize-hook nil
+  "Hook that is run right before a remember process is finalized.
+The remember buffer is still current when this hook runs."
+  :group 'org-capture
+  :type 'hook)
+
+;;; The property list for keeping information about the capture process
+
+(defvar org-capture-plist nil
+  "Plist for the current capture process, global, to avoid having to pass it.")
+(defvar org-capture-current-plist nil
+  "Local variable holding the plist in a capture buffer.
+This is used to store the plist for use when finishing a capture process.
+Another such process might have changed the global varaible by then.")
+
+(defun org-capture-put (&rest stuff)
+  (while stuff
+    (setq org-capture-plist (plist-put org-capture-plist
+				       (pop stuff) (pop stuff)))))
+(defun org-capture-get (prop &optional local)
+  (plist-get (if local org-capture-current-plist org-capture-plist) prop))
+
+(defun org-capture-member (prop)
+  (plist-get org-capture-plist prop))
+
+;;; The minor mode
+
+(defvar org-capture-mode-map (make-sparse-keymap)
+  "Keymap for org-capture-mode, a minor mode.
+Use this map to set additional keybindings for when Org-mode is used
+for a Remember buffer.")
+
+(defvar org-capture-mode-hook nil
+  "Hook for the minor `org-capture-mode'.")
+
+(define-minor-mode org-capture-mode
+  "Minor mode for special key bindings in a remember buffer."
+  nil " Rem" org-capture-mode-map
+  (org-set-local
+   'header-line-format
+   "Capture buffer.  Finish `C-c C-c', refile `C-c C-w', abort `C-c C-k'.")
+  (run-hooks 'org-capture-mode-hook))
+(define-key org-capture-mode-map "\C-c\C-c" 'org-capture-finalize)
+(define-key org-capture-mode-map "\C-c\C-k" 'org-capture-kill)
+(define-key org-capture-mode-map "\C-c\C-w" 'org-capture-refile)
+
+;;; The main commands
+
+(defun org-capture (&optional goto keys)
+  "Capture something.
+
+This will let you select a template from org-capture-templates, and then
+file new captured information.  The text is immediately inserted at the
+target location, and an indirect buffer is shown where you can edit it.
+Pressing `C-c C-c' brings you back to the previous state of Emacs,
+so that you can continue your work.
+
+When called interactively with a `C-u' prefix argument GOTO, don't capture
+anything, just go to the file/headline where the selected template
+stores its notes.  With a double prefix arg `C-u C-u', go to the last
+note stored.
+
+When called with a `C-0' (zero) prefix, insert a template at point.
+
+Lisp programs can set KEYS to a string associated with a template in
+`org-capture-templates'.  In this case, interactive selection will be
+bypassed."
+  (interactive "P")
+  (cond
+   ((equal goto '(4)) (org-capture-goto-target))
+   ((equal goto '(16)) (org-capture-goto-last-stored))
+   (t
+    ;; set temporary variables that will be needed in
+    ;; `org-select-remember-template'
+    (let* ((orig-buf (current-buffer))
+	   (annotation (org-store-link nil))
+	   (initial (and (org-region-active-p)
+			 (buffer-substring (point) (mark))))
+	   (entry (org-capture-select-template keys)))
+      (if (equal entry "C")
+	  (customize-variable 'org-capture-templates)
+	(org-capture-set-plist entry)
+	(org-capture-put :original-buffer orig-buf :annotation annotation
+			 :initial initial)
+	(org-capture-put :default-time
+			 (or org-overriding-default-time
+			     (org-current-time)))
+	(org-capture-set-target-location)
+	(org-capture-put :template (org-capture-fill-template))
+	(if (equal goto 0)
+	    ;;insert at point
+	    (org-capture-insert-template-here)
+	  (org-capture-place-template)
+	  (if (org-capture-get :immediate-finish)
+	      (org-capture-finalize)
+	    (if (and (org-mode-p)
+		     (org-capture-get :clock-in))
+		(condition-case nil
+		    (progn
+		      (if (org-clock-is-active)
+			  (org-capture-put :interrupted-clock
+					   (copy-marker org-clock-marker)))
+		      (org-clock-in)
+		      (org-set-local 'org-capture-clock-was-started t))
+		  (error
+		   "Could not start the clock in this capture buffer"))))))))))
+
+(defun org-capture-finalize ()
+  "Finalize the capture process."
+  (interactive)
+  (unless (and org-capture-mode
+	       (buffer-base-buffer (current-buffer)))
+    (error "This does not seem to be a capture buffer for Org-mode"))
+
+  (let ((beg (point-min))
+	(end (point-max)))
+    (widen)
+    ;; Make sure that the empty lines after are correct
+    (when (and (> (point-max) end) ; indeed, the buffer was still narrowed
+	       (member (org-capture-get :type 'local)
+		       '(entry item checkitem plain)))
+      (save-excursion
+	(goto-char end)
+	(org-capture-empty-lines-after
+	 (or (org-capture-get :empty-lines 'local) 0))))
+    ;; Postprocessing:  Update Statistics cookies, do the sorting
+    (when (org-mode-p)
+      (save-excursion
+	(when (ignore-errors (org-back-to-heading))
+	  (org-update-parent-todo-statistics)
+	  (org-update-checkbox-count)))
+      ;; FIXME Here we should do the sorting
+      ;; If we have added a table line, maybe recompute?
+      (when (and (eq (org-capture-get :type 'local) 'table-line)
+		 (org-at-table-p))
+	(if (org-table-get-stored-formulas)
+	    (org-table-recalculate 'all) ;; FIXME: Should we iterate???
+	  (org-table-align)))
+      )
+    ;; Store this place as the last one where we stored something
+    ;; Do the marking in the base buffer, so that it makes sense after
+    ;; the indirect buffer has been killed.
+    (let ((pos (point)))
+      (with-current-buffer (buffer-base-buffer (current-buffer))
+	(save-excursion
+	  (save-restriction
+	    (widen)
+	    (goto-char pos)
+	    (bookmark-set "org-capture-last-stored")
+	    (move-marker org-capture-last-stored-marker (point))))))
+    ;; Run the hook
+    (run-hooks 'org-capture-before-finalize-hook)
+    ;; Did we start the clock in this capture buffer?
+    (when (and org-capture-clock-was-started
+	       org-clock-marker (marker-buffer org-clock-marker)
+	       (equal (marker-buffer org-clock-marker) (buffer-base-buffer))
+	       (> org-clock-marker (point-min))
+	       (< org-clock-marker (point-max)))
+      ;; Looks like the clock we started is still running.  Clock out.
+      (let (org-log-note-clock-out) (org-clock-out))
+      (when (and (org-capture-get :clock-resume 'local)
+		 (markerp (org-capture-get :interrupted-clock 'local))
+		 (buffer-live-p (marker-buffer
+				 (org-capture-get :interrupted-clock 'local))))
+	(org-with-point-at (org-capture-get :interrupted-clock 'local)
+	  (org-clock-in))
+	(message "Interrupted clock has been resumed")))
+
+    ;; Kill the indirect buffer
+    (save-buffer)
+    (let ((return-wconf (org-capture-get :return-to-wconf 'local)))
+      (kill-buffer (current-buffer))
+      ;; Restore the window configuration before capture
+      (set-window-configuration return-wconf))))
+
+(defun org-capture-refile ()
+  "Finalize the current capture and then refile the entry.
+Refiling is done from the base buffer, because the indirect buffer is then
+already gone."
+  (interactive)
+  (let ((pos (point)) (base (buffer-base-buffer (current-buffer))))
+    (org-capture-finalize)
+    (save-window-excursion
+      (save-excursion
+	(set-buffer (or base (current-buffer)))
+	(save-excursion
+	  (save-restriction
+	    (widen)
+	    (goto-char pos)
+	    (call-interactively 'org-refile)))))))
+
+(defun org-capture-kill ()
+  "Abort the current capture process."
+  (interactive)
+  ;; FIXME: This does not do the right thing, we need to remove the new stuff
+  ;; By hand it is easy: undo, then kill the buffer
+  (let ((org-note-abort t))
+    (org-capture-finalize)))
+
+(defun org-capture-goto-last-stored ()
+  "Go to the location where the last remember note was stored."
+  (interactive)
+  (org-goto-marker-or-bmk org-capture-last-stored-marker
+			  "org-capture-last-stored")
+  (message "This is the last note stored by in a capture process"))
+
+;;; Supporting functions for handling the process
+
+(defun org-capture-set-target-location (&optional target)
+  "Find target buffer and position and store then in the property list."
+  (let ((target-entry-p t))
+    (setq target (or target (org-capture-get :target)))
+    (save-excursion
+      (cond
+       ((eq (car target) 'file)
+	(set-buffer (org-capture-target-buffer (nth 1 target)))
+	(setq target-entry-p nil))
+
+       ((eq (car target) 'id)
+	(let ((loc (org-id-find (nth 1 target))))
+	  (if (not loc)
+	      (error "Cannot find target ID \"%s\"" (nth 1 target))
+	    (set-buffer (org-capture-target-buffer (car loc)))
+	    (goto-char (cdr loc)))))
+
+       ((eq (car target) 'file+headline)
+	(set-buffer (org-capture-target-buffer (nth 1 target)))
+	(let ((hd (nth 2 target)))
+	  (goto-char (point-min))
+	  (if (re-search-forward
+	       (format org-complex-heading-regexp-format (regexp-quote hd))
+	       nil t)
+	      (goto-char (point-at-bol))
+	    (goto-char (point-max))
+	    (or (bolp) (insert "\n"))
+	    (insert "* " hd "\n")
+	    (beginning-of-line 0))))
+
+       ((eq (car target) 'file+olp)
+	(let ((m (org-find-olp (cdr target))))
+	  (set-buffer (marker-buffer m))
+	  (goto-char m)))
+
+       ((eq (car target) 'file+regexp)
+	(set-buffer (org-capture-target-buffer (nth 1 target)))
+	(goto-char (point-min))
+	(if (re-search-forward (nth 1 target) nil t)
+	    (progn
+	      (goto-char (match-beginning 0))
+	      (setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
+	  (kill-buffer (current-buffer))
+	  (error "No match for target regexp in file %s" (nth 1 target))))
+
+       ((eq (car target) 'file+datetree)
+	(set-buffer (org-capture-target-buffer (nth 1 target)))
+	;; Make a date tree entry, with the current date (or yesterday,
+	;; if we are extending dates for a couple of hours)
+	(org-datetree-find-date-create
+	 (calendar-gregorian-from-absolute
+	  (time-to-days
+	   (time-subtract (current-time)
+			  (list 0 (* 3600 org-extend-today-until) 0))))))
+
+       ((eq (car target) 'file+function)
+	(set-buffer (org-capture-target-buffer (nth 1 target)))
+	(funcall (nth 1 target))
+	(setq target-entry-p (and (org-mode-p) (org-at-heading-p))))
+
+       ((eq (car target) 'clock)
+	(if (and (markerp org-clock-hd-marker)
+		 (marker-buffer org-clock-hd-marker))
+	    (progn (set-buffer (org-capture-target-buffer
+				(marker-buffer org-clock-hd-marker)))
+		   (goto-char org-clock-hd-marker))
+	  (error "No running clock that could be used as capture target")))
+
+       (t (error "Invalid capture target specification")))
+
+      (org-capture-put :buffer (current-buffer) :pos (point)
+		       :target-entry-p target-entry-p))))
+
+(defun org-capture-target-buffer (file)
+  "Get a buffer for FILE."
+  (or (org-find-base-buffer-visiting file)
+      (find-file-noselect (expand-file-name file org-directory))))
+
+(defun org-capture-steal-local-variables (buffer)
+  "Install Org-mode local variables"
+  (mapc (lambda (v)
+	  (ignore-errors (org-set-local (car v) (cdr v))))
+	(buffer-local-variables buffer)))
+
+(defun org-capture-place-template ()
+  "Insert the template at the target location, and display the buffer."
+  (org-capture-put :return-to-wconf (current-window-configuration))
+  (delete-other-windows)
+  (org-switch-to-buffer-other-window
+   (org-capture-get-indirect-buffer (org-capture-get :buffer) "CAPTURE"))
+  (show-all)
+  (goto-char (org-capture-get :pos))
+  (org-set-local 'org-capture-target-marker
+		 (move-marker (make-marker) (point)))
+  (let* ((template (org-capture-get :template))
+	 (type (org-capture-get :type)))
+    (case type
+      ((nil entry) (org-capture-place-entry))
+      (table-line (org-capture-place-table-line))
+      (plain (org-capture-place-plain-text))
+      (item  (org-capture-place-item))))
+  (org-capture-mode 1)
+  (org-set-local 'org-capture-current-plist org-capture-plist))
+
+(defun org-capture-place-entry ()
+  "Place the template as a new Org entry."
+  (let* ((txt (org-capture-get :template))
+	 (reversed (org-capture-get :prepend))
+	 (target-entry-p (org-capture-get :target-entry-p))
+	 level beg end)
+    (cond
+     ((not target-entry-p)
+      ;; Insert as top-level entry, either at beginning or at end of file
+      (setq level 1)
+      (if reversed
+	  (progn (goto-char (point-min))
+		 (outline-next-heading))
+	(goto-char (point-max))
+	(or (bolp) (insert "\n"))))
+     (t
+      ;; Insert as a child of the current entry
+      (and (looking-at "\\*+")
+	   (setq level (- (match-end 0) (match-beginning 0))))
+      (setq level (org-get-valid-level (or level 1) 1))
+      (if reversed
+	  (progn
+	    (outline-next-heading)
+	    (or (bolp) (insert "\n")))
+	(org-end-of-subtree t t)
+	(or (bolp) (insert "\n")))))
+    (org-capture-empty-lines-before)
+    (setq beg (point))
+    (org-paste-subtree level txt 'for-yank)
+    (org-capture-empty-lines-after 1)
+    (outline-next-heading)
+    (setq end (point))
+    (org-capture-narrow beg (1- end))
+    (if (re-search-forward "%\\?" end t) (replace-match ""))))
+
+(defun org-capture-place-item ()
+  "Place the template as a new plain list item."
+  (let* ((txt (org-capture-get :template))
+	 (target-entry-p (org-capture-get :target-entry-p))
+	 ind beg end)
+    (cond
+     ((not target-entry-p)
+      ;; Insert as top-level entry, either at beginning or at end of file
+      (setq beg (point-min) end (point-max)))
+     (t
+      (setq beg (1+ (point-at-eol))
+	    end (save-excursion (outline-next-heading) (point)))))
+    (if (org-capture-get :prepend)
+	(progn
+	  (goto-char beg)
+	  (if (re-search-forward (concat "^" (org-item-re)) nil t)
+	      (progn
+		(goto-char (match-beginning 0))
+		(setq ind (org-get-indentation)))
+	    (goto-char end)
+	    (setq ind 0)))
+      (goto-char end)
+      (if (re-search-backward (concat "^" (org-item-re)) nil t)
+	  (progn
+	    (setq ind (org-get-indentation))
+	    (org-end-of-item))
+	(setq ind 0)))
+    ;; Remove common indentation
+    (setq txt (org-remove-indentation txt))
+    ;; Make sure this is indeed an item
+    (unless (string-match (concat "\\`" (org-item-re)) txt)
+      (setq txt (concat "- "
+			(mapconcat 'identity (split-string txt "\n")
+				   "\n  "))))
+    ;; Set the correct indentation, depending on context
+    (setq ind (make-string ind ?\ ))
+    (setq txt (concat ind
+		      (mapconcat 'identity (split-string txt "\n")
+				 (concat "\n" ind))))
+    ;; Insert, with surrounding empty lines
+    (org-capture-empty-lines-before)
+    (setq beg (point))
+    (insert txt)
+    (org-capture-empty-lines-after 1)
+    (setq end (point))
+    (org-capture-narrow beg (1- end))
+    (if (re-search-forward "%\\?" end t) (replace-match ""))))
+
+(defun org-capture-place-table-line ()
+  "Place the template as a table line."
+  (let* ((txt (org-capture-get :template))
+	 (target-entry-p (org-capture-get :target-entry-p))
+	 ind beg end)
+    (cond
+     ((not target-entry-p)
+      (setq beg (point-min) end (point-max)))
+     (t
+      (setq beg (1+ (point-at-eol))
+	    end (save-excursion (outline-next-heading) (point)))))
+    (if (re-search-forward org-table-dataline-regexp end t)
+	(let ((b (org-table-begin)) (e (org-table-end)))
+	  (goto-char e)
+	  (if (looking-at "[ \t]*#\\+TBLFM:")
+	      (forward-line 1))
+	  (narrow-to-region b (point)))
+      (goto-char end)
+      (insert "\n\n")
+      (narrow-to-region (1- (point)) (point)))
+    ;; We are narrowed to the table, or to an empty line if there was no table
+
+    ;; Check if the template is good
+    (if (not (string-match org-table-dataline-regexp txt))
+	(setq txt "| %?Bad template |\n"))
+
+    (if (org-capture-get :prepend)
+	(progn
+	  (goto-char (point-min))
+	  (re-search-forward org-table-hline-regexp nil t)
+	  (beginning-of-line 1)
+	  (re-search-forward org-table-dataline-regexp nil t)
+	  (beginning-of-line 1)
+	  (setq beg (point))
+	  (org-table-insert-row)
+	  (beginning-of-line 1)
+	  (delete-region (point) (1+ (point-at-eol)))
+	  (insert txt)
+	  (setq end (point)))
+      (goto-char (point-max))
+      (re-search-backward org-table-dataline-regexp nil t)
+      (beginning-of-line 1)
+      (org-table-insert-row 'below)
+      (beginning-of-line 1)
+      (delete-region (point) (1+ (point-at-eol)))
+      (setq beg (point))
+      (insert txt)
+      (setq end (point)))
+    (goto-char beg)
+    (if (re-search-forward "%\\?" end t) (replace-match ""))
+    (org-table-align)))
+
+(defun org-capture-place-plain-text ()
+  "Place the template plainly."
+  (let* ((txt (org-capture-get :template))
+	 beg end)
+    (goto-char (if (org-capture-get :prepend) (point-min) (point-max)))
+    (or (bolp) (newline))
+    (org-capture-empty-lines-before)
+    (setq beg (point))
+    (insert txt)
+    (org-capture-empty-lines-after 1)
+    (setq end (point))
+    (org-capture-narrow beg (1- end))
+    (if (re-search-forward "%\\?" end t) (replace-match ""))))
+
+(defun org-capture-narrow (beg end)
+  "Narrow, unless configuraion says not to narrow."
+  (unless (org-capture-get :unnarrowed)
+    (narrow-to-region beg end)
+    (goto-char beg)))
+
+(defun org-capture-empty-lines-before (&optional n)
+  "Arrange for the correct number of empty lines before the insertion point.
+Point will be after the empty lines, so insertion can direcetly be done."
+  (setq n (or n (org-capture-get :empty-lines) 0))
+  (let ((pos (point)))
+    (org-back-over-empty-lines)
+    (delete-region (point) pos)
+    (newline n)))
+
+(defun org-capture-empty-lines-after (&optional n)
+  "Arrange for the correct number of empty lines after the inserted string.
+Point will remain at the first line after the inserted text."
+  (setq n (or n (org-capture-get :empty-lines) 0))
+  (org-back-over-empty-lines)
+  (while (looking-at "[ \t]*\n") (replace-match ""))
+  (let ((pos (point)))
+    (newline n)
+    (goto-char pos)))
+
+(defvar org-clock-marker) ; Defined in org.el
+;;;###autoload
+(defun org-capture-insert-template-here ()
+  (let* ((template (org-capture-get :template))
+	 (type  (org-capture-get :type))
+	 beg end pp)
+    (or (bolp) (newline))
+    (setq beg (point))
+    (cond
+     ((and (eq type 'entry) (org-mode-p))
+      (org-paste-subtree nil template t))
+     ((and (memq type '(item checkitem))
+	   (org-mode-p)
+	   (save-excursion (skip-chars-backward " \t\n")
+			   (setq pp (point))
+			   (org-in-item-p)))
+      (goto-char pp)
+      (org-insert-item)
+      (skip-chars-backward " ")
+      (skip-chars-backward "-+*0123456789).")
+      (delete-region (point) (point-at-eol))
+      (setq beg (point))
+      (org-remove-indentation template)
+      (insert template)
+      (org-capture-empty-lines-after)
+      (goto-char beg)
+      (org-maybe-renumber-ordered-list)
+      (org-end-of-item)
+      (setq end (point)))
+     (t (insert template)))
+    (setq end (point))
+    (goto-char beg)
+    (if (re-search-forward "%\\?" end t)
+	(replace-match ""))))
+
+(defun org-capture-set-plist (entry)
+  "Initialize the property list from the template definition."
+  (setq org-capture-plist (copy-sequence (nthcdr 5 entry)))
+  (org-capture-put :key (car entry) :description (nth 1 entry)
+		   :target (nth 3 entry))
+  (let ((txt (nth 4 entry)) (type (or (nth 2 entry) 'entry)))
+    (when (or (not txt) (not (string-match "\\S-" txt)))
+      ;; The template may be empty or omitted for special types.
+      ;; Here we insert the default templates for such cases.
+      (cond
+       ((eq type 'item) (setq txt "- %?"))
+       ((eq type 'checkitem) (setq txt "- [ ] %?"))
+       ((eq type 'table-line) (setq txt "| %? |"))
+       ((member type '(nil entry)) (setq txt "* %?"))))
+    (org-capture-put :template txt :type type)))
+
+(defun org-capture-goto-target (&optional template-key)
+  "Go to the target location of a capture template.
+The user is queried for the template."
+  (interactive)
+  (let* (org-select-template-temp-major-mode
+	 (entry (org-capture-select-template template-key)))
+    (unless entry
+      (error "No capture emplate selected"))
+    (org-capture-set-plist entry)
+    (org-capture-set-target-location)
+    (switch-to-buffer (org-capture-get :buffer))
+    (goto-char (org-capture-get :pos))))
+
+(defun org-capture-get-indirect-buffer (&optional buffer prefix)
+  "Make an indirect buffer for a capture process.
+Use PREFIX as a prefix for the name of the indirect buffer."
+  (setq buffer (or buffer (current-buffer)))
+  (let ((n 1) (base (buffer-name buffer)) bname)
+    (setq bname (concat prefix "-" base))
+    (while (buffer-live-p (get-buffer bname))
+      (setq bname (concat prefix "-" (number-to-string (incf n)) "-" base)))
+    (condition-case nil
+        (make-indirect-buffer buffer bname 'clone)
+      (error (make-indirect-buffer buffer bname)))))
+
+
+;;; The template code
+
+(defun org-capture-select-template (&optional keys)
+  "Select a capture template.
+Lisp programs can force the template by setting KEYS to a string."
+  (when org-capture-templates
+    (if keys
+	(or (assoc keys org-capture-templates)
+	    (error "No capture template referred to by \"%s\" keys"))
+      (org-mks org-capture-templates
+	       "Select a capture template\n========================="
+	       "Template key: "
+	       '(("C" "Customize org-capture-templates"))))))
+
+(defun org-capture-fill-template (&optional template initial annotation)
+  "Fill a template and return the filled template as a string.
+The template may still contain \"%?\" for cursor positioning."
+  (setq template (or template (org-capture-get :template)))
+  (when (stringp initial)
+    (setq initial (org-no-properties initial))
+    (remove-text-properties 0 (length initial) '(read-only t) initial))
+  (let* ((buffer (org-capture-get :buffer))
+	 (file (buffer-file-name (or (buffer-base-buffer buffer) buffer)))
+	 (ct (org-capture-get :default-time))
+	 (dct (decode-time ct))
+	 (ct1
+	  (if (< (nth 2 dct) org-extend-today-until)
+	      (encode-time 0 59 23 (1- (nth 3 dct)) (nth 4 dct) (nth 5 dct))
+	    ct))
+	 (plist-p (if org-store-link-plist t nil))
+	 (v-c (and (> (length kill-ring) 0) (current-kill 0)))
+	 (v-x (or (org-get-x-clipboard 'PRIMARY)
+		  (org-get-x-clipboard 'CLIPBOARD)
+		  (org-get-x-clipboard 'SECONDARY)))
+	 (v-t (format-time-string (car org-time-stamp-formats) ct))
+	 (v-T (format-time-string (cdr org-time-stamp-formats) ct))
+	 (v-u (concat "[" (substring v-t 1 -1) "]"))
+	 (v-U (concat "[" (substring v-T 1 -1) "]"))
+	 ;; `initial' and `annotation' might habe been passed.
+	 ;; But if the property list has them, we prefer those values
+	 (v-i (or (plist-get org-store-link-plist :initial)
+		  initial
+		  (org-capture-get :initial)
+		  ""))
+	 (v-a (or (plist-get org-store-link-plist :annotation)
+		  annotation
+		  (org-capture-get :annotation)
+		  ""))
+	 ;; Is the link empty?  Then we do not want it...
+	 (v-a (if (equal v-a "[[]]") "" v-a))
+	 (clipboards (remove nil (list v-i
+				       (org-get-x-clipboard 'PRIMARY)
+				       (org-get-x-clipboard 'CLIPBOARD)
+				       (org-get-x-clipboard 'SECONDARY)
+				       v-c)))
+	 (v-A (if (and v-a
+		       (string-match
+			"\\[\\(\\[.*?\\]\\)\\(\\[.*?\\]\\)?\\]" v-a))
+		  (replace-match "[\\1[%^{Link description}]]" nil nil v-a)
+		v-a))
+	 (v-n user-full-name)
+	 (v-k (if (marker-buffer org-clock-marker)
+		  (org-substring-no-properties org-clock-heading)))
+	 (v-K (if (marker-buffer org-clock-marker)
+		  (org-make-link-string
+		   (buffer-file-name (marker-buffer org-clock-marker))
+		   org-clock-heading)))
+	 v-I
+	 (org-startup-folded nil)
+	 (org-inhibit-startup t)
+	 org-time-was-given org-end-time-was-given x
+	 prompt completions char time pos default histvar)
+
+    (setq org-store-link-plist
+	  (plist-put org-store-link-plist :annotation v-a)
+	  org-store-link-plist
+	  (plist-put org-store-link-plist :initial v-i))
+
+    (unless template (setq template "") (message "No template") (ding)
+	    (sit-for 1))
+    (save-window-excursion
+      (delete-other-windows)
+      (switch-to-buffer (get-buffer-create "*Capture*"))
+      (insert template)
+      (goto-char (point-min))
+      (org-capture-steal-local-variables buffer)
+      ;; Simple %-escapes
+      (while (re-search-forward "%\\([tTuUaiAcxkKI]\\)" nil t)
+	(unless (org-capture-escaped-%)
+	  (when (and initial (equal (match-string 0) "%i"))
+	    (save-match-data
+	      (let* ((lead (buffer-substring
+			    (point-at-bol) (match-beginning 0))))
+		(setq v-i (mapconcat 'identity
+				     (org-split-string initial "\n")
+				     (concat "\n" lead))))))
+	  (replace-match
+	   (or (eval (intern (concat "v-" (match-string 1)))) "")
+	   t t)))
+
+      ;; %[] Insert contents of a file.
+      (goto-char (point-min))
+      (while (re-search-forward "%\\[\\(.+\\)\\]" nil t)
+	(unless (org-capture-escaped-%)
+	  (let ((start (match-beginning 0))
+		(end (match-end 0))
+		(filename (expand-file-name (match-string 1))))
+	    (goto-char start)
+	    (delete-region start end)
+	    (condition-case error
+		(insert-file-contents filename)
+	      (error (insert (format "%%![Couldn't insert %s: %s]"
+				     filename error)))))))
+      ;; %() embedded elisp
+      (goto-char (point-min))
+      (while (re-search-forward "%\\((.+)\\)" nil t)
+	(unless (org-capture-escaped-%)
+	  (goto-char (match-beginning 0))
+	  (let ((template-start (point)))
+	    (forward-char 1)
+	    (let ((result
+		   (condition-case error
+		       (eval (read (current-buffer)))
+		     (error (format "%%![Error: %s]" error)))))
+	      (delete-region template-start (point))
+	      (insert result)))))
+
+      ;; From the property list
+      (when plist-p
+	(goto-char (point-min))
+	(while (re-search-forward "%\\(:[-a-zA-Z]+\\)" nil t)
+	  (unless (org-capture-escaped-%)
+	    (and (setq x (or (plist-get org-store-link-plist
+					(intern (match-string 1))) ""))
+		 (replace-match x t t)))))
+
+      ;; Turn on org-mode in temp buffer, set local variables
+      ;; This is to support completion in interactive prompts
+      (let ((org-inhibit-startup t)) (org-mode))
+      ;; Interactive template entries
+      (goto-char (point-min))
+      (while (re-search-forward "%^\\({\\([^}]*\\)}\\)?\\([gGtTuUCLp]\\)?"
+				nil t)
+	(unless (org-capture-escaped-%)
+	  (setq char (if (match-end 3) (match-string 3))
+		prompt (if (match-end 2) (match-string 2)))
+	  (goto-char (match-beginning 0))
+	  (replace-match "")
+	  (setq completions nil default nil)
+	  (when prompt
+	    (setq completions (org-split-string prompt "|")
+		  prompt (pop completions)
+		  default (car completions)
+		  histvar (intern (concat
+				   "org-capture-template-prompt-history::"
+				   (or prompt "")))
+		  completions (mapcar 'list completions)))
+	  (cond
+	   ((member char '("G" "g"))
+	    (let* ((org-last-tags-completion-table
+		    (org-global-tags-completion-table
+		     (if (equal char "G")
+			 (org-agenda-files)
+		       (and file (list file)))))
+		   (org-add-colon-after-tag-completion t)
+		   (ins (org-icompleting-read
+			 (if prompt (concat prompt ": ") "Tags: ")
+			 'org-tags-completion-function nil nil nil
+			 'org-tags-history)))
+	      (setq ins (mapconcat 'identity
+				   (org-split-string
+				    ins (org-re "[^[:alnum:]_@]+"))
+				       ":"))
+	      (when (string-match "\\S-" ins)
+		(or (equal (char-before) ?:) (insert ":"))
+		(insert ins)
+		(or (equal (char-after) ?:) (insert ":")))))
+	   ((equal char "C")
+	    (cond ((= (length clipboards) 1) (insert (car clipboards)))
+		  ((> (length clipboards) 1)
+		   (insert (read-string "Clipboard/kill value: "
+					(car clipboards) '(clipboards . 1)
+					(car clipboards))))))
+	   ((equal char "L")
+	    (cond ((= (length clipboards) 1)
+		   (org-insert-link 0 (car clipboards)))
+		  ((> (length clipboards) 1)
+		   (org-insert-link 0 (read-string "Clipboard/kill value: "
+						   (car clipboards)
+						   '(clipboards . 1)
+						   (car clipboards))))))
+	   ((equal char "p")
+	    (let*
+		((prop (org-substring-no-properties prompt))
+		 (pall (concat prop "_ALL"))
+		 (allowed
+		  (with-current-buffer
+		      (get-buffer (file-name-nondirectory file))
+		    (or (cdr (assoc pall org-file-properties))
+			(cdr (assoc pall org-global-properties))
+			(cdr (assoc pall org-global-properties-fixed)))))
+		 (existing (with-current-buffer
+			       (get-buffer (file-name-nondirectory file))
+			     (mapcar 'list (org-property-values prop))))
+		 (propprompt (concat "Value for " prop ": "))
+		 (val (if allowed
+			  (org-completing-read
+			   propprompt
+			   (mapcar 'list (org-split-string allowed
+							   "[ \t]+"))
+			   nil 'req-match)
+			(org-completing-read-no-i propprompt
+						  existing nil nil
+						  "" nil ""))))
+	      (org-set-property prop val)))
+	   (char
+	    ;; These are the date/time related ones
+	    (setq org-time-was-given (equal (upcase char) char))
+	    (setq time (org-read-date (equal (upcase char) "U") t nil
+				      prompt))
+	    (org-insert-time-stamp time org-time-was-given
+				   (member char '("u" "U"))
+				   nil nil (list org-end-time-was-given)))
+	   (t
+	    (let (org-completion-use-ido)
+	      (insert (org-completing-read-no-i
+		       (concat (if prompt prompt "Enter string")
+			       (if default (concat " [" default "]"))
+			       ": ")
+		       completions nil nil nil histvar default)))))))
+      ;; Make sure there are no empty lines before the text, and that
+      ;; it ends with a newline character
+      (goto-char (point-min))
+      (while (looking-at "[ \t]*\n") (replace-match ""))
+      (if (re-search-forward "[ \t\n]*\\'" nil t) (replace-match "\n"))
+      ;; Return the expanded tempate and kill the temporary buffer
+      (untabify (point-min) (point-max))
+      (set-buffer-modified-p nil)
+      (prog1 (buffer-string) (kill-buffer (current-buffer))))))
+
+(defun org-capture-escaped-% ()
+  "Check if % was escaped - if yes, unescape it now."
+  (if (equal (char-before (match-beginning 0)) ?\\)
+      (progn
+	(delete-region (1- (match-beginning 0)) (match-beginning 0))
+	t)
+    nil))
+
+;;;###autoload
+(defun org-capture-import-remember-templates ()
+  "Set org-capture-templates to be similar to `org-remember-templates'."
+  (interactive)
+  (when (and (yes-or-no-p
+	      "Import old remember templates into org-capture-templates? ")
+	     (yes-or-no-p
+	      "Note that this will remove any templates currently defined in `org-capture-templates'.  Do you still want to go ahead? "))
+    (setq org-capture-templates
+	  (mapcar
+	   (lambda (entry)
+	     (let ((desc (car entry))
+		   (key (char-to-string (nth 1 entry)))
+		   (template (nth 2 entry))
+		   (file (or (nth 3 entry) org-default-notes-file))
+		   (position (nth 4 entry))
+		   (type 'entry)
+		   (prepend org-reverse-note-order)
+		   immediate target)
+	       (cond
+		((member position '(top bottom))
+		 (setq target (list 'file file)
+		       prepend (eq position 'top)))
+		((eq position 'date-tree)
+		 (setq target (list 'file+datetree file)
+		       prepend nil))
+		(t (setq target
+			 (list 'file+headline file
+			       (or position org-remember-default-headline)))))
+
+	       (when (string-match "%!" template)
+		 (setq template (replace-match "" t t template)
+		       immediate t))
+
+	       (append (list key desc type target template)
+		       (if prepend '(:prepend t))
+		       (if immediate '(:immediate-finish t)))))
+
+	   org-remember-templates))))
+
+(provide 'org-capture)
+
+;; arch-tag: 986bf41b-8ada-4e28-bf20-e8388a7205a0
+
+;;; org-capture.el ends here
+
+

+ 6 - 0
lisp/org-compat.el

@@ -132,6 +132,12 @@ If DELETE is non-nil, delete all those overlays."
           (if delete (delete-overlay ov) (push ov found))))
           (if delete (delete-overlay ov) (push ov found))))
     found))
     found))
 
 
+(defun org-get-x-clipboard (value)
+  "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21."
+  (if (eq window-system 'x)
+      (let ((x (org-get-x-clipboard-compat value)))
+	(if x (org-no-properties x)))))
+
 ;; Miscellaneous functions
 ;; Miscellaneous functions
 
 
 (defun org-add-hook (hook function &optional append local)
 (defun org-add-hook (hook function &optional append local)

+ 2 - 2
lisp/org-datetree.el

@@ -36,8 +36,8 @@
 (defvar org-datetree-base-level 1
 (defvar org-datetree-base-level 1
   "The level at which years should be placed in the date tree.
   "The level at which years should be placed in the date tree.
 This is normally one, but if the buffer has an entry with a DATE_TREE
 This is normally one, but if the buffer has an entry with a DATE_TREE
-property, the date tree will become a subtree under that entry, so the
-base level will be properly adjusted.")
+property (any value), the date tree will become a subtree under that entry,
+so the base level will be properly adjusted.")
 
 
 ;;;###autoload
 ;;;###autoload
 (defun org-datetree-find-date-create (date &optional keep-restriction)
 (defun org-datetree-find-date-create (date &optional keep-restriction)

+ 123 - 0
lisp/org-mks.el

@@ -0,0 +1,123 @@
+;;; org-mks.el --- Multi-key-selection for Org-mode
+
+;; Copyright (C) 2010  Free Software Foundation, Inc.
+
+;; Author: Carsten Dominik <carsten at orgmode dot org>
+;; Keywords: outlines, hypermedia, calendar, wp
+;; Homepage: http://orgmode.org
+;; Version: 6.36trans
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs 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, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defun org-mks (table title &optional prompt specials)
+  "Select a member of an alist with multiple keys.
+TABLE is the alist which should contain entries where the car is a string.
+There should be two types of entries.
+
+1. prefix descriptions like (\"a\" \"Description\")
+   This indicates that `a' is a prefix key for multi-letter selection, and
+   that there are entries following with keys like \"ab\", \"ax\"...
+
+2. Selectable members must have more than two elements, with the first
+   being the string of keys that lead to selecting it, and the second a
+   short description string of the item.
+
+The command will then make a temporary buffer listing all entries
+that can be selected with a single key, and all the sinke key
+prefixes.  When you press the key for a single-letter enty, it is selected.
+When you press a prefix key, the commands (and maybe further prefixes)
+under this key will be shown and offered for selection.
+
+TITLE will be placed over the selection in the temporary buffer,
+PROMPT will be used when prompting for a key.  SPECIAL is an alist with
+also (\"key\" \"description\") entries.  When they are selected, 
+
+
+"
+  (setq prompt (or prompt "Select: "))
+  (let (tbl orig-table dkey ddesc des-keys allowed-keys current prefix rtn)
+    (save-window-excursion
+      (org-switch-to-buffer-other-window "*Org Select*")
+      (setq orig-table table)
+      (catch 'exit
+	(while t
+	  (erase-buffer)
+	  (insert title "\n\n")
+	  (setq tbl table
+		des-keys nil
+		allowed-keys nil)
+	  (setq prefix (if current (concat current " ") ""))
+	  (while tbl
+	    (cond
+	     ((and (= 2 (length (car tbl))) (= (length (caar tbl)) 1))
+	      ;; This is a description on this level
+	      (setq dkey (caar tbl) ddesc (cadar tbl))
+	      (pop tbl)
+	      (push dkey des-keys)
+	      (push dkey allowed-keys)
+	      (insert prefix "[" dkey "]" "..." "  " ddesc "..." "\n")
+	      ;; Skip keys which are below this prefix
+	      (setq re (concat "\\`" (regexp-quote dkey)))
+	      (while (and tbl (string-match re (caar tbl))) (pop tbl)))
+	     ((= 2 (length (car tbl)))
+	      ;; Not yet a usable description, skip it
+	      )
+	     (t
+	      ;; usable entry on this level
+	      (insert prefix "[" (caar tbl) "]" "     " (nth 1 (car tbl)) "\n")
+	      (push (caar tbl) allowed-keys)
+	      (pop tbl))))
+	  (when specials
+	    (insert "-------------------------------------------------------------------------------\n")
+	    (let ((sp specials))
+	      (while sp
+		(insert (format "[%s]     %s\n"
+				(caar sp) (nth 1 (car sp))))
+		(push (caar sp) allowed-keys)
+		(pop sp))))
+	  (push "\C-g" allowed-keys)
+	  (goto-char (point-min))
+	  (if (not (pos-visible-in-window-p (point-max)))
+	      (org-fit-window-to-buffer))
+	  (message prompt)
+	  (setq pressed (char-to-string (read-char-exclusive)))
+	  (while (not (member pressed allowed-keys))
+	    (message "Invalid key `%s'" pressed) (sit-for 1)
+	    (message prompt)
+	    (setq pressed (char-to-string (read-char-exclusive))))
+	  (if (equal pressed "\C-g") (error "Abort"))
+	  (if (assoc pressed specials) (throw 'exit (setq rtn pressed)))
+	  (unless (member pressed des-keys)
+	    (throw 'exit (setq rtn (rassoc (cdr (assoc pressed table))
+					   orig-table))))
+	  (setq current (concat current pressed))
+	  (setq table (mapcar 
+		       (lambda (x)
+			 (if (and (> (length (car x)) 1)
+				  (equal (substring (car x) 0 1) pressed))
+			     (cons (substring (car x) 1) (cdr x))
+			   nil))
+		       table))
+	  (setq table (remove nil table)))))
+    (kill-buffer "*Org Select*")
+    rtn))
+
+(provide 'org-mks)
+
+;; arch-tag: 4ea90d0e-c6e4-4684-bd61-baf878712f9f
+
+;;; org-mks.el ends here

+ 0 - 6
lisp/org-remember.el

@@ -392,12 +392,6 @@ RET at beg-of-buf -> Append to file as level 2 headline
 			 char0))))))
 			 char0))))))
       (cddr (assoc char templates)))))
       (cddr (assoc char templates)))))
 
 
-(defun org-get-x-clipboard (value)
-  "Get the value of the x clipboard, compatible with XEmacs, and GNU Emacs 21."
-  (if (eq window-system 'x)
-      (let ((x (org-get-x-clipboard-compat value)))
-	(if x (org-no-properties x)))))
-
 ;;;###autoload
 ;;;###autoload
 (defun org-remember-apply-template (&optional use-char skip-interactive)
 (defun org-remember-apply-template (&optional use-char skip-interactive)
   "Initialize *remember* buffer with template, invoke `org-mode'.
   "Initialize *remember* buffer with template, invoke `org-mode'.

+ 12 - 5
lisp/org.el

@@ -4317,7 +4317,11 @@ means to push this value onto the list in the variable.")
 	    org-complex-heading-regexp-format
 	    org-complex-heading-regexp-format
 	    (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
 	    (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
 		    (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
 		    (mapconcat 'regexp-quote org-todo-keywords-1 "\\|")
-		    "\\)\\>\\)?\\(?:[ \t]*\\(\\[#.\\]\\)\\)?[ \t]*\\(%s\\)"
+		    "\\)\\>\\)?"
+		    "\\(?:[ \t]*\\(\\[#.\\]\\)\\)?"
+		    "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
+		    "[ \t]*\\(%s\\)"
+		    "\\(?:[ \t]*\\(?:\\[[0-9%%/]+\\]\\)\\)?" ;; stats cookie
 		    "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$")
 		    "\\(?:[ \t]+\\(:[[:alnum:]_@:]+:\\)\\)?[ \t]*$")
 	    org-nl-done-regexp
 	    org-nl-done-regexp
 	    (concat "\n\\*+[ \t]+"
 	    (concat "\n\\*+[ \t]+"
@@ -13775,7 +13779,7 @@ completion."
     (skip-chars-forward " \t")
     (skip-chars-forward " \t")
     (run-hook-with-args 'org-property-changed-functions key nval)))
     (run-hook-with-args 'org-property-changed-functions key nval)))
 
 
-(defun org-find-olp (path)
+(defun org-find-olp (path &optional this-buffer)
   "Return a marker pointing to the entry at outline path OLP.
   "Return a marker pointing to the entry at outline path OLP.
 If anything goes wrong, throw an error.
 If anything goes wrong, throw an error.
 You can wrap this call to cathc the error like this:
 You can wrap this call to cathc the error like this:
@@ -13785,9 +13789,12 @@ You can wrap this call to cathc the error like this:
     (error (nth 1 msg)))
     (error (nth 1 msg)))
 
 
 The return value will then be either a string with the error message,
 The return value will then be either a string with the error message,
-or a marker if everyhing is OK."
-  (let* ((file (pop path))
-	 (buffer (find-file-noselect file))
+or a marker if everyhing is OK.
+
+If THIS-BUFFER is set, the putline path does not contain a file,
+only headings."
+  (let* ((file (if this-buffer buffer-file-name (pop path)))
+	 (buffer (if this-buffer (current-buffer) (find-file-noselect file)))
 	 (level 1)
 	 (level 1)
 	 (lmin 1)
 	 (lmin 1)
 	 (lmax 1)
 	 (lmax 1)