Fixes for org-capture-templates-contexts

[Paul Sexton <psexton.2a@gmail.com>]

org-capture-templates-contexts currently appears not to work. The structure
that the function 'org-contextualize-validate-key' expects to find in the
variable seems quite different from the structure described in the docstring.

Here are fixed versions of the functions 'org-contextualize-validate-key'
and 'org-contextualize-keys', both from org.el. I have also added some
functionality:
- new context specifiers in-buffer and not-in-buffer
- in-mode and not-in-mode expect a symbol, not a regexp.
- if a rule specifies a template that has 'sub-templates', those sub-templates
  will also be affected by the rule. For example if you have templates 't',
  'ta', 'tb' and 'tc', you can specify a rule for 't' which will affect
  all of them.

I have also rewritten the docstring for org-capture-templates-contexts,
from org-capture.el.

--------------------


(defcustom org-capture-templates-contexts nil
  "Alist of capture templates and valid contexts.

Each entry in the alist takes the form:
   (KEY [USUAL-KEY] CONTEXT [CONTEXT...])

Where:
   KEY :: a string of one or more letters, identifying a
       capture template.
   USUAL-KEY :: if supplied, this is the string that identifies
       the capture template in `org-capture-templates', while KEY
       becomes the string which will be used to select the
       template only in the present context (see below).
   CONTEXT :: a context definition.

Each context definition (CONTEXT) takes the form:
       FUNCTION
   or  (SPECIFIER . ARGUMENT)

Where:
   FUNCTION :: either a lambda form or a symbol naming a function.
      The function must take no arguments.
   SPECIFIER :: a symbol matching one of the context specifiers listed
      below.
   ARGUMENT :: either a string regular expression (for in-file and
      in-buffer), or a symbol (for in-mode).

Here are the available context specifiers:

      in-file: command displayed in files matching regex
    in-buffer: command displayed in buffers matching regex
      in-mode: command displayed if major mode matches symbol
  not-in-file: command not displayed in files matching regex
not-in-buffer: command not displayed in buffers matching regex
  not-in-mode: command not displayed when major mode matches symbol

For example, if you have a capture template \"c\" and you want
this template to be accessible only from `message-mode' buffers,
use this:

   '((\"c\" (in-mode . message-mode)))

If you include several context definitions, the agenda command
will be accessible if at least one of them is valid.

If the template specified by KEY has sub-templates, they will also
be affected by the rule (unless they have their own rules). For
example, if you have a template `t' and sub-templates `ta', `tb'
and `tc', then a rule for `t' will affect whether all of those
contexts are accessible.

You can also bind a key to another agenda custom command
depending on contextual rules.

    '((\"c\" \"d\" (in-file . \"\\.el$\") (in-buffer \"scratch\")))

Here it means: in files ending in `.el' and in buffers whose
name contains `scratch', use \"c\" as the
key for the capture template otherwise associated with \"d\".
\(The template originally associated with \"q\" is not displayed
to avoid duplicates.)"
  :version "24.3"
  :group 'org-capture
  :type '(repeat (list :tag "Rule"
		       (string :tag "        Capture key")
		       (string :tag "Replace by template")
		       (repeat :tag "Available when"
			      (choice
			       (cons :tag "Condition"
				     (choice
				      (const :tag "In file" in-file)
				      (const :tag "Not in file" not-in-file)
				      (const :tag "In mode" in-mode)
				      (const :tag "Not in mode" not-in-mode))
				     (regexp))
			       (function :tag "Custom function"))))))


(defun org-contextualize-validate-key (key contexts)
  "Check CONTEXTS for agenda or capture KEY."
  (let (clause context res)
    (while (setq clause (pop contexts))
      (destructuring-bind (context-key old-key . context-list) clause
        (mapc
         (lambda (context)
           (when
               (cond
                ((and (>= (length context-key) (length key))
                      (not (equal key context-key)))
                 nil)
                ((and (< (length context-key) (length key))
                      (not (string-prefix-p context-key key)))
                 nil)
                ((functionp context)
                 (funcall context))
                (t
                 (destructuring-bind (context-spec . context-arg) context
                   (message "Considering context %s" context)
                   (or (and (eq context-spec 'in-file)
                            (buffer-file-name)
                            (string-match context-arg
                                          (buffer-file-name)))
                       (and (eq context-spec 'in-buffer)
                            (string-match context-arg
                                          (buffer-name)))
                       (and (eq context-spec 'in-mode)
                            (eq context-arg major-mode))
                       (when (and (eq context-spec 'not-in-file)
                                  (buffer-file-name))
                         (not (string-match context-arg
                                            (buffer-file-name))))
                       (and (eq context-spec 'not-in-buffer)
                            (not (string-match context-arg
                                               (buffer-name))))
                       (when (eq context-spec 'not-in-mode)
                         (not (eq context-arg major-mode)))))))
             (push clause res)))
         context-list)))
    (delete-dups (delq nil res))))


(defun org-contextualize-keys (alist contexts)
  "Return valid elements in ALIST depending on CONTEXTS.

`org-agenda-custom-commands' or `org-capture-templates' are the
values used for ALIST, and `org-agenda-custom-commands-contexts'
or `org-capture-templates-contexts' are the associated contexts
definitions."
  (let ((contexts
	 ;; normalize contexts
	 (mapcar
	  (lambda(c) (cond ((listp (cadr c))
			    (list (car c) (car c) (cadr c)))
			   ((string= "" (cadr c))
			    (list (car c) (car c) (caddr c)))
			   (t c))) contexts))
	(a alist) c r s)
    ;; loop over all commands or templates
    (while (setq c (pop a))
      (let (vrules repl)
	(cond
	 ((and (not (assoc (car c) contexts))
               (not (assoc (string (elt (car c) 0)) contexts)))
	  (push c r))
	 ((and (or (assoc (car c) contexts)
                   (assoc (string (elt (car c) 0)) contexts))
	       (setq vrules (org-contextualize-validate-key
			     (car c) contexts)))
	  (mapc (lambda (vr)
		  (when (not (equal (car vr) (cadr vr)))
		    (setq repl vr))) vrules)
	  (if (not repl) (push c r)
	    (push (cadr repl) s)
	    (push
	     (cons (car c)
		   (cdr (or (assoc (cadr repl) alist)
			    (error "Undefined key `%s' as contextual replacement for `%s'"
				   (cadr repl) (car c)))))
	     r))))))
    ;; Return limited ALIST, possibly with keys modified, and deduplicated
    (delq
     nil
     (delete-dups
      (mapcar (lambda (x)
		(let ((tpl (car x)))
		  (when (not (delq
			      nil
			      (mapcar (lambda(y)
					(equal y tpl)) s))) x)))
	      (reverse r))))))