summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorBastien Guerry <bzg@altern.org>2012-08-24 01:48:45 +0200
committerBastien Guerry <bzg@altern.org>2012-08-24 12:18:02 +0200
commit9d73d6d680f991b7477aed8937feec390dfe91b7 (patch)
tree11e2d886b69458c8e17bbf5f9ded631077f8d574
parent6c94ea051824edea55356351600875d456325b49 (diff)
downloadorg-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.el106
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.