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.

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,
 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
-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
 the template.  This element can be a list of major modes or a function.

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)))
      ((equal ans ?r)
       (org-agenda-do-action '(org-remember) t))
+     ((equal ans ?c)
+      (org-agenda-do-action '(org-capture) t))
      ((equal ans ?\ )
       (let ((cw (selected-window)))
 	(org-switch-to-buffer-other-window

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))))
     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
 
 (defun org-add-hook (hook function &optional append local)

lisp/org-datetree.el

@@ -36,8 +36,8 @@
 (defvar org-datetree-base-level 1
   "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
-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
 (defun org-datetree-find-date-create (date &optional keep-restriction)

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

lisp/org-remember.el

@@ -392,12 +392,6 @@ RET at beg-of-buf -> Append to file as level 2 headline
 			 char0))))))
       (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
 (defun org-remember-apply-template (&optional use-char skip-interactive)
   "Initialize *remember* buffer with template, invoke `org-mode'.

lisp/org.el

@@ -4317,7 +4317,11 @@ means to push this value onto the list in the variable.")
 	    org-complex-heading-regexp-format
 	    (concat "^\\(\\*+\\)[ \t]+\\(?:\\("
 		    (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]*$")
 	    org-nl-done-regexp
 	    (concat "\n\\*+[ \t]+"
@@ -13775,7 +13779,7 @@ completion."
     (skip-chars-forward " \t")
     (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.
 If anything goes wrong, throw an error.
 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)))
 
 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)
 	 (lmin 1)
 	 (lmax 1)