diff options
author | Bastien Guerry <bzg@altern.org> | 2012-08-24 01:48:45 +0200 |
---|---|---|
committer | Bastien Guerry <bzg@altern.org> | 2012-08-24 12:18:02 +0200 |
commit | 9d73d6d680f991b7477aed8937feec390dfe91b7 (patch) | |
tree | 11e2d886b69458c8e17bbf5f9ded631077f8d574 | |
parent | 6c94ea051824edea55356351600875d456325b49 (diff) | |
download | org-mode-9d73d6d680f991b7477aed8937feec390dfe91b7.tar.gz |
org.el (org-contextualize-agenda-or-capture): Normalize contexts
* org.el (org-contextualize-agenda-or-capture): Normalize
contexts.
-rw-r--r-- | lisp/org.el | 106 |
1 files changed, 59 insertions, 47 deletions
diff --git a/lisp/org.el b/lisp/org.el index c8b6c54..5f0ad6a 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -8623,54 +8623,66 @@ to execute outside of tables." "Return a subset of elements in ALIST depending on CONTEXTS. ALIST can be either `org-agenda-custom-commands' or `org-capture-templates'." - (let ((a alist) c r s val repl) - (while (setq c (pop a)) ; loop over commands or templates - (cond ((not (assoc (car c) contexts)) - (push c r)) - ((and (assoc (car c) contexts) - (let (rr) - (setq val - (org-rule-validate - (and (mapc ; check all contexts associations - (lambda (rl) - (when (equal (car rl) (car c)) - (setq rr (delq nil (append rr (car (last rl))))))) - contexts) - rr))))) - (setq repl - (car (delq nil - (mapcar (lambda(cnt) - (when (and (member (car val) (caddr cnt)) - (equal (car c) (car cnt))) cnt)) - contexts)))) - (unless (equal (car c) (cadr repl)) - (push (cadr repl) s)) - (push (cons (car c) (cdr (assoc (cadr repl) alist))) r)))) + (let ((contexts + ;; normalize contexts + (mapcar + (lambda(c) (if (listp (cadr c)) + (list (car c) (car c) (cadr c)) + c)) contexts)) + (a alist) c r s) + ;; loop over all commands or templates + (while (setq c (pop a)) + (let (vrules repl) + (cond + ((not (assoc (car c) contexts)) + (push c r)) + ((and (assoc (car c) contexts) + (setq vrules (org-contexts-validate + (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 - (mapcar (lambda(x) - (let ((tpl (car x))) - (when (not (delq nil - (mapcar (lambda(y) - (equal y tpl)) s))) x))) - r)))) - -(defun org-rule-validate (rules) - "Check if one of RULES is valid in this buffer." - (let (r res) - (while (setq r (pop rules)) - (when (or (and (eq (car r) 'in-file) - (buffer-file-name) - (string-match (cdr r) (buffer-file-name))) - (and (eq (car r) 'in-mode) - (string-match (cdr r) (symbol-name major-mode))) - (when (and (eq (car r) 'not-in-file) - (buffer-file-name)) - (not (string-match (cdr r) (buffer-file-name)))) - (when (eq (car r) 'not-in-mode) - (not (string-match (cdr r) (symbol-name major-mode))))) - (push r res))) - (delq nil res))) + (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)))))) + +(defun org-contexts-validate (key contexts) + "Return valid CONTEXTS." + (let (r rr res) + (while (setq r (pop contexts)) + (mapc + (lambda (rr) + (when + (and (equal key (car r)) + (or (and (eq (car rr) 'in-file) + (buffer-file-name) + (string-match (cdr rr) (buffer-file-name))) + (and (eq (car rr) 'in-mode) + (string-match (cdr rr) (symbol-name major-mode))) + (when (and (eq (car rr) 'not-in-file) + (buffer-file-name)) + (not (string-match (cdr rr) (buffer-file-name)))) + (when (eq (car rr) 'not-in-mode) + (not (string-match (cdr rr) (symbol-name major-mode)))))) + (push r res))) + (car (last r)))) + (delete-dups (delq nil res)))) (defun org-context-p (&rest contexts) "Check if local context is any of CONTEXTS. |