Re: Fixes for org-capture-templates-contexts

[Darlan Cavalcante Moreira <darcamo@gmail.com>]

By a great coincidence I just discovered org-capture-templates-contexts
yesterday but could not make it work yet (didn't have much time to
investigate it). Is it possible to have capture templates that do not
appear in any buffer but can be called from lisp? The idea is that I'm
implementing some org-capture templates right now that I only intend to
call via "(org-capture nil 'some letter')" and never via "C-c c". Maybe
today is my luck day and it is exactly this new "not-in-buffer" context you
have just added?

ps: this rule affecting all sub-templates will also be very userful.

--
Darlan

At Thu, 10 Jan 2013 21:04:54 +0000 (UTC),
Paul Sexton wrote:
> 
> 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))))))
> 
> 
>