RFC: interactive tag query adjustment

[Christopher League <league@contrapunctus.net>]

Hi, I've been using org-mode for about a year, and recently updated to  
the latest release.  I was happy to discover the enhanced tag query  
features ("phone|email/NEXT|SOMEDAY", etc) and started rethinking my  
configuration a little.

I'd like to have an interface for interactive query adjustment.  For  
example, in a tags match (C-c a m, org-tags-view), I could begin with  
the query "phone/NEXT" and type the keys "/h" to quickly turn it into  
"phone+home/NEXT" and then ";s" to get "phone+home/NEXT|SOMEDAY", then  
"=[" to clear all the tags to "/NEXT|SOMEDAY", and so on.  Then, one  
more keystroke to save the current query into org-agenda-custom- 
commands would be icing on the cake.

I'm new to the mailing list, so maybe some functionality like this was  
discussed before.  Closest I found was a thread begun by John W in  
October, wherein "interactive" and "query" were mentioned together a  
few times... http://thread.gmane.org/gmane.emacs.orgmode/3628  but I  
don't think it's the same idea.


Below is a first crack at this kind of functionality.  It's very  
rough.. I've hacked elisp before, but I'm new to the org.el code.   
Load this after org, then "C-c a m", enter any match query, then try  
some of the commands with your tag shortcut keys.  It assumes you have  
some settings in org-tag-alist.  Currently, todo shortcut keys may not  
work because org-todo-key-alist is still nil; it's not clear to me how  
this should get initialized from agenda-mode.

Let me know what you think!  Thanks Carsten and community for all the  
hard work and great ideas surrounding org-mode!

Chris


;; Currently, it seems the query string is kept only as part of the
;; org-agenda-redo-command, which is a Lisp form.  A distinct global
;; would be cleaner, but that entails modifications to org-mode."
;; org-agenda-redo-command: (org-tags-view 'nil (if current-prefix-arg  
nil ""))
;;  The "" will contain the current query string
(defun cl-agenda-twiddle-query ()
   (cl-agenda-twiddle-iter org-agenda-redo-command))

(defun cl-agenda-twiddle-iter (sexp)
   "Find query string in SEXP and replace it."
   (if (consp sexp)
       (if (and (stringp (car sexp)) (null (cdr sexp)))
           (setcar sexp (cl-agenda-apply-changes (car sexp)))
         (cl-agenda-twiddle-iter (car sexp))
         (cl-agenda-twiddle-iter (cdr sexp)))))

(defun cl-agenda-apply-changes (str)
   (cl-agenda-apply-iter cl-agenda-op str cl-agenda-args))

(defun cl-agenda-apply-iter (op str args)
   (if (null args) str
     (funcall op (cl-agenda-apply-iter op str (cdr args))
              (caar args) (cdar args))))

(defun cl-agenda-tag-clear (query kind str)
   (if (string-match (concat "[-\\+&|]?\\b" (regexp-quote str) "\\b")
                     query)
       (replace-match "" t t query)
     query))

(defun cl-agenda-tag-set (query kind str)
   (let* ((q (cl-agenda-tag-clear query kind str))
          (r (string-match "\\([^/]*\\)/?\\(.*\\)" q))
          (q1 (match-string 1 q))
          (q2 (match-string 2 q)))
     (cond
      ((eq kind 'tag)
       (concat q1 cl-agenda-sep str "/" q2))
      ((equal cl-agenda-sep "+")
       (concat q1 "/+" str))
      (t
       (concat q1 "/" q2 cl-agenda-sep str)))))

;;; ALMOST THERE: IT'S JUST THAT org-todo-key-alist IS NIL.

(defun cl-agenda-all (kind alist)
   (cond
    ((null alist) nil)
    ((stringp (caar alist))
     (cons (cons kind (caar alist)) (cl-agenda-all kind (cdr alist))))
    (t
     (cl-agenda-all kind (cdr alist)))))

(defun cl-agenda-interp-key (k)
   (let ((v1 (rassoc k org-tag-alist))
         (v2 (rassoc k org-todo-key-alist)))
     (cond
      ((eq k ? ) (append (cl-agenda-all 'tag org-tag-alist)
                         (cl-agenda-all 'todo org-todo-key-alist)))
      ((eq k ?[) (cl-agenda-all 'tag org-tag-alist))
      ((eq k ?]) (cl-agenda-all 'todo org-todo-key-alist))
      (v1 (list (cons 'tag (car v1))))
      (v2 (list (cons 'todo (car v2))))
      (t nil))))

(defun cl-agenda-tag-cmd (op sep)
   (let ((cl-agenda-op op)
         (cl-agenda-sep sep)
         (cl-agenda-args (cl-agenda-interp-key (read-char))))
     (cl-agenda-twiddle-query))
   (org-agenda-redo))

(defun cl-agenda-tag-clear-cmd ()
   (interactive)
   (cl-agenda-tag-cmd 'cl-agenda-tag-clear ""))

(defun cl-agenda-tag-and-cmd ()
   (interactive)
   (cl-agenda-tag-cmd 'cl-agenda-tag-set "+"))

(defun cl-agenda-tag-or-cmd ()
   (interactive)
   (cl-agenda-tag-cmd 'cl-agenda-tag-set "|"))

(defun cl-agenda-tag-not-cmd ()
   (interactive)
   (cl-agenda-tag-cmd 'cl-agenda-tag-set "-"))

(org-defkey org-agenda-mode-map "=" 'cl-agenda-tag-clear-cmd)
(org-defkey org-agenda-mode-map "/" 'cl-agenda-tag-and-cmd)
(org-defkey org-agenda-mode-map ";" 'cl-agenda-tag-or-cmd)
(org-defkey org-agenda-mode-map "\\" 'cl-agenda-tag-not-cmd)