Added new file org-iq.el.
This file allows interactive tags query construction.
This commit is contained in:
Carsten Dominik
parent
99e22650f8
commit
b538898bf9
|
|
@ -17,6 +17,7 @@ org-depend.el --- TODO dependencies for Org-mode
|
||||||
org-elisp-symbol.el --- Org links to emacs-lisp symbols
|
org-elisp-symbol.el --- Org links to emacs-lisp symbols
|
||||||
org-expiry.el --- expiry mechanism for Org entries
|
org-expiry.el --- expiry mechanism for Org entries
|
||||||
org-id.el --- Global id's for identifying entries
|
org-id.el --- Global id's for identifying entries
|
||||||
|
org-iq.el --- Interactive modification of tags query
|
||||||
org-irc.el --- Store links to IRC sessions.
|
org-irc.el --- Store links to IRC sessions.
|
||||||
org-iswitchb.el --- use iswitchb to select Org buffer
|
org-iswitchb.el --- use iswitchb to select Org buffer
|
||||||
org-man.el --- Support for links to manpages in Org-mode
|
org-man.el --- Support for links to manpages in Org-mode
|
||||||
|
|
|
||||||
|
|
@ -0,0 +1,308 @@
|
||||||
|
;;; org-interactive-query.el --- Interactive modification of agenda query
|
||||||
|
;;
|
||||||
|
;; Copyright 2007 Free Software Foundation, Inc.
|
||||||
|
;;
|
||||||
|
;; Author: Christopher League <league at contrapunctus dot net>
|
||||||
|
;; Version: 1.0
|
||||||
|
;; Keywords: org, wp
|
||||||
|
;;
|
||||||
|
;; This program is free software; you can redistribute it and/or modify
|
||||||
|
;; it under the terms of the GNU General Public License as published by
|
||||||
|
;; the Free Software Foundation; either version 3, or (at your option)
|
||||||
|
;; any later version.
|
||||||
|
;;
|
||||||
|
;; This program is distributed in the hope that it will be useful,
|
||||||
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||||||
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||||||
|
;; GNU General Public License for more details.
|
||||||
|
;;
|
||||||
|
;; You should have received a copy of the GNU General Public License
|
||||||
|
;; along with this program; if not, write to the Free Software
|
||||||
|
;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
|
||||||
|
;;
|
||||||
|
;;; Commentary:
|
||||||
|
;;
|
||||||
|
|
||||||
|
;; This ibrary implements interactive modification of a tags/todo query
|
||||||
|
;; in the org-agenda. It adds 4 keys to the agenda
|
||||||
|
;;
|
||||||
|
;; / add a keyword as a positive selection criterion
|
||||||
|
;; \ add a keyword as a newgative selection criterion
|
||||||
|
;; = clear a keyword from the selection string
|
||||||
|
;; ;
|
||||||
|
|
||||||
|
(require 'org)
|
||||||
|
|
||||||
|
(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
|
||||||
|
(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
|
||||||
|
(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
|
||||||
|
(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
|
||||||
|
|
||||||
|
;;; Agenda interactive query manipulation
|
||||||
|
|
||||||
|
(defcustom org-agenda-query-selection-single-key t
|
||||||
|
"Non-nil means, query manipulation exits after first change.
|
||||||
|
When nil, you have to press RET to exit it.
|
||||||
|
During query selection, you can toggle this flag with `C-c'.
|
||||||
|
This variable can also have the value `expert'. In this case, the window
|
||||||
|
displaying the tags menu is not even shown, until you press C-c again."
|
||||||
|
:group 'org-agenda
|
||||||
|
:type '(choice
|
||||||
|
(const :tag "No" nil)
|
||||||
|
(const :tag "Yes" t)
|
||||||
|
(const :tag "Expert" expert)))
|
||||||
|
|
||||||
|
(defun org-agenda-query-selection (current op table &optional todo-table)
|
||||||
|
"Fast query manipulation with single keys.
|
||||||
|
CURRENT is the current query string, OP is the initial
|
||||||
|
operator (one of \"+|-=\"), TABLE is an alist of tags and
|
||||||
|
corresponding keys, possibly with grouping information.
|
||||||
|
TODO-TABLE is a similar table with TODO keywords, should these
|
||||||
|
have keys assigned to them. If the keys are nil, a-z are
|
||||||
|
automatically assigned. Returns the new query string, or nil to
|
||||||
|
not change the current one."
|
||||||
|
(let* ((fulltable (append table todo-table))
|
||||||
|
(maxlen (apply 'max (mapcar
|
||||||
|
(lambda (x)
|
||||||
|
(if (stringp (car x)) (string-width (car x)) 0))
|
||||||
|
fulltable)))
|
||||||
|
(fwidth (+ maxlen 3 1 3))
|
||||||
|
(ncol (/ (- (window-width) 4) fwidth))
|
||||||
|
(expert (eq org-agenda-query-selection-single-key 'expert))
|
||||||
|
(exit-after-next org-agenda-query-selection-single-key)
|
||||||
|
(done-keywords org-done-keywords)
|
||||||
|
tbl char cnt e groups ingroup
|
||||||
|
tg c2 c c1 ntable rtn)
|
||||||
|
(save-window-excursion
|
||||||
|
(if expert
|
||||||
|
(set-buffer (get-buffer-create " *Org tags*"))
|
||||||
|
(delete-other-windows)
|
||||||
|
(split-window-vertically)
|
||||||
|
(org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
|
||||||
|
(erase-buffer)
|
||||||
|
(org-set-local 'org-done-keywords done-keywords)
|
||||||
|
(insert "Query: " current "\n")
|
||||||
|
(org-agenda-query-op-line op)
|
||||||
|
(insert "\n\n")
|
||||||
|
(org-fast-tag-show-exit exit-after-next)
|
||||||
|
(setq tbl fulltable char ?a cnt 0)
|
||||||
|
(while (setq e (pop tbl))
|
||||||
|
(cond
|
||||||
|
((equal e '(:startgroup))
|
||||||
|
(push '() groups) (setq ingroup t)
|
||||||
|
(when (not (= cnt 0))
|
||||||
|
(setq cnt 0)
|
||||||
|
(insert "\n"))
|
||||||
|
(insert "{ "))
|
||||||
|
((equal e '(:endgroup))
|
||||||
|
(setq ingroup nil cnt 0)
|
||||||
|
(insert "}\n"))
|
||||||
|
(t
|
||||||
|
(setq tg (car e) c2 nil)
|
||||||
|
(if (cdr e)
|
||||||
|
(setq c (cdr e))
|
||||||
|
;; automatically assign a character.
|
||||||
|
(setq c1 (string-to-char
|
||||||
|
(downcase (substring
|
||||||
|
tg (if (= (string-to-char tg) ?@) 1 0)))))
|
||||||
|
(if (or (rassoc c1 ntable) (rassoc c1 table))
|
||||||
|
(while (or (rassoc char ntable) (rassoc char table))
|
||||||
|
(setq char (1+ char)))
|
||||||
|
(setq c2 c1))
|
||||||
|
(setq c (or c2 char)))
|
||||||
|
(if ingroup (push tg (car groups)))
|
||||||
|
(setq tg (org-add-props tg nil 'face
|
||||||
|
(cond
|
||||||
|
((not (assoc tg table))
|
||||||
|
(org-get-todo-face tg))
|
||||||
|
(t nil))))
|
||||||
|
(if (and (= cnt 0) (not ingroup)) (insert " "))
|
||||||
|
(insert "[" c "] " tg (make-string
|
||||||
|
(- fwidth 4 (length tg)) ?\ ))
|
||||||
|
(push (cons tg c) ntable)
|
||||||
|
(when (= (setq cnt (1+ cnt)) ncol)
|
||||||
|
(insert "\n")
|
||||||
|
(if ingroup (insert " "))
|
||||||
|
(setq cnt 0)))))
|
||||||
|
(setq ntable (nreverse ntable))
|
||||||
|
(insert "\n")
|
||||||
|
(goto-char (point-min))
|
||||||
|
(if (and (not expert) (fboundp 'fit-window-to-buffer))
|
||||||
|
(fit-window-to-buffer))
|
||||||
|
(setq rtn
|
||||||
|
(catch 'exit
|
||||||
|
(while t
|
||||||
|
(message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
|
||||||
|
(if groups " [!] no groups" " [!]groups")
|
||||||
|
(if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
||||||
|
(setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
||||||
|
(cond
|
||||||
|
((= c ?\r) (throw 'exit t))
|
||||||
|
((= c ?!)
|
||||||
|
(setq groups (not groups))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
||||||
|
((= c ?\C-c)
|
||||||
|
(if (not expert)
|
||||||
|
(org-fast-tag-show-exit
|
||||||
|
(setq exit-after-next (not exit-after-next)))
|
||||||
|
(setq expert nil)
|
||||||
|
(delete-other-windows)
|
||||||
|
(split-window-vertically)
|
||||||
|
(org-switch-to-buffer-other-window " *Org tags*")
|
||||||
|
(and (fboundp 'fit-window-to-buffer)
|
||||||
|
(fit-window-to-buffer))))
|
||||||
|
((or (= c ?\C-g)
|
||||||
|
(and (= c ?q) (not (rassoc c ntable))))
|
||||||
|
(setq quit-flag t))
|
||||||
|
((= c ?\ )
|
||||||
|
(setq current "")
|
||||||
|
(if exit-after-next (setq exit-after-next 'now)))
|
||||||
|
((= c ?\[) ; clear left
|
||||||
|
(org-agenda-query-decompose current)
|
||||||
|
(setq current (concat "/" (match-string 2 current)))
|
||||||
|
(if exit-after-next (setq exit-after-next 'now)))
|
||||||
|
((= c ?\]) ; clear right
|
||||||
|
(org-agenda-query-decompose current)
|
||||||
|
(setq current (match-string 1 current))
|
||||||
|
(if exit-after-next (setq exit-after-next 'now)))
|
||||||
|
((= c ?\t)
|
||||||
|
(condition-case nil
|
||||||
|
(setq current (read-string "Query: " current))
|
||||||
|
(quit))
|
||||||
|
(if exit-after-next (setq exit-after-next 'now)))
|
||||||
|
;; operators
|
||||||
|
((or (= c ?/) (= c ?+)) (setq op "+"))
|
||||||
|
((or (= c ?\;) (= c ?|)) (setq op "|"))
|
||||||
|
((or (= c ?\\) (= c ?-)) (setq op "-"))
|
||||||
|
((= c ?=) (setq op "="))
|
||||||
|
;; todos
|
||||||
|
((setq e (rassoc c todo-table) tg (car e))
|
||||||
|
(setq current (org-agenda-query-manip
|
||||||
|
current op groups 'todo tg))
|
||||||
|
(if exit-after-next (setq exit-after-next 'now)))
|
||||||
|
;; tags
|
||||||
|
((setq e (rassoc c ntable) tg (car e))
|
||||||
|
(setq current (org-agenda-query-manip
|
||||||
|
current op groups 'tag tg))
|
||||||
|
(if exit-after-next (setq exit-after-next 'now))))
|
||||||
|
(if (eq exit-after-next 'now) (throw 'exit t))
|
||||||
|
(goto-char (point-min))
|
||||||
|
(beginning-of-line 1)
|
||||||
|
(delete-region (point) (point-at-eol))
|
||||||
|
(insert "Query: " current)
|
||||||
|
(beginning-of-line 2)
|
||||||
|
(delete-region (point) (point-at-eol))
|
||||||
|
(org-agenda-query-op-line op)
|
||||||
|
(goto-char (point-min)))))
|
||||||
|
(if rtn current nil))))
|
||||||
|
|
||||||
|
(defun org-agenda-query-op-line (op)
|
||||||
|
(insert "Operator: "
|
||||||
|
(org-agenda-query-op-entry (equal op "+") "/+" "and")
|
||||||
|
(org-agenda-query-op-entry (equal op "|") ";|" "or")
|
||||||
|
(org-agenda-query-op-entry (equal op "-") "\\-" "not")
|
||||||
|
(org-agenda-query-op-entry (equal op "=") "=" "clear")))
|
||||||
|
|
||||||
|
(defun org-agenda-query-op-entry (matchp chars str)
|
||||||
|
(if matchp
|
||||||
|
(org-add-props (format "[%s %s] " chars (upcase str))
|
||||||
|
nil 'face 'org-todo)
|
||||||
|
(format "[%s]%s " chars str)))
|
||||||
|
|
||||||
|
(defun org-agenda-query-decompose (current)
|
||||||
|
(string-match "\\([^/]*\\)/?\\(.*\\)" current))
|
||||||
|
|
||||||
|
(defun org-agenda-query-clear (current prefix tag)
|
||||||
|
(if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
|
||||||
|
(replace-match "" t t current)
|
||||||
|
current))
|
||||||
|
|
||||||
|
(defun org-agenda-query-manip (current op groups kind tag)
|
||||||
|
"Apply an operator to a query string and a tag.
|
||||||
|
CURRENT is the current query string, OP is the operator, GROUPS is a
|
||||||
|
list of lists of tags that are mutually exclusive. KIND is 'tag for a
|
||||||
|
regular tag, or 'todo for a TODO keyword, and TAG is the tag or
|
||||||
|
keyword string."
|
||||||
|
;; If this tag is already in query string, remove it.
|
||||||
|
(setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
|
||||||
|
(if (equal op "=") current
|
||||||
|
;; When using AND, also remove mutually exclusive tags.
|
||||||
|
(if (equal op "+")
|
||||||
|
(loop for g in groups do
|
||||||
|
(if (member tag g)
|
||||||
|
(mapc (lambda (x)
|
||||||
|
(setq current
|
||||||
|
(org-agenda-query-clear current "\\+" x)))
|
||||||
|
g))))
|
||||||
|
;; Decompose current query into q1 (tags) and q2 (TODOs).
|
||||||
|
(org-agenda-query-decompose current)
|
||||||
|
(let* ((q1 (match-string 1 current))
|
||||||
|
(q2 (match-string 2 current)))
|
||||||
|
(cond
|
||||||
|
((eq kind 'tag)
|
||||||
|
(concat q1 op tag "/" q2))
|
||||||
|
;; It's a TODO; when using AND, drop all other TODOs.
|
||||||
|
((equal op "+")
|
||||||
|
(concat q1 "/+" tag))
|
||||||
|
(t
|
||||||
|
(concat q1 "/" q2 op tag))))))
|
||||||
|
|
||||||
|
(defun org-agenda-query-global-todo-keys (&optional files)
|
||||||
|
"Return alist of all TODO keywords and their fast keys, in all FILES."
|
||||||
|
(let (alist)
|
||||||
|
(unless (and files (car files))
|
||||||
|
(setq files (org-agenda-files)))
|
||||||
|
(save-excursion
|
||||||
|
(loop for f in files do
|
||||||
|
(set-buffer (find-file-noselect f))
|
||||||
|
(loop for k in org-todo-key-alist do
|
||||||
|
(setq alist (org-agenda-query-merge-todo-key
|
||||||
|
alist k)))))
|
||||||
|
alist))
|
||||||
|
|
||||||
|
(defun org-agenda-query-merge-todo-key (alist entry)
|
||||||
|
(let (e)
|
||||||
|
(cond
|
||||||
|
;; if this is not a keyword (:startgroup, etc), ignore it
|
||||||
|
((not (stringp (car entry))))
|
||||||
|
;; if keyword already exists, replace char if it's null
|
||||||
|
((setq e (assoc (car entry) alist))
|
||||||
|
(when (null (cdr e)) (setcdr e (cdr entry))))
|
||||||
|
;; if char already exists, prepend keyword but drop char
|
||||||
|
((rassoc (cdr entry) alist)
|
||||||
|
(message "TRACE POSITION 2")
|
||||||
|
(setq alist (cons (cons (car entry) nil) alist)))
|
||||||
|
;; else, prepend COPY of entry
|
||||||
|
(t
|
||||||
|
(setq alist (cons (cons (car entry) (cdr entry)) alist)))))
|
||||||
|
alist)
|
||||||
|
|
||||||
|
(defun org-agenda-query-generic-cmd (op)
|
||||||
|
"Activate query manipulation with OP as initial operator."
|
||||||
|
(let ((q (org-agenda-query-selection org-agenda-query-string op
|
||||||
|
org-tag-alist
|
||||||
|
(org-agenda-query-global-todo-keys))))
|
||||||
|
(when q
|
||||||
|
(setq org-agenda-query-string q)
|
||||||
|
(org-agenda-redo))))
|
||||||
|
|
||||||
|
(defun org-agenda-query-clear-cmd ()
|
||||||
|
"Activate query manipulation, to clear a tag from the string."
|
||||||
|
(interactive)
|
||||||
|
(org-agenda-query-generic-cmd "="))
|
||||||
|
|
||||||
|
(defun org-agenda-query-and-cmd ()
|
||||||
|
"Activate query manipulation, initially using the AND (+) operator."
|
||||||
|
(interactive)
|
||||||
|
(org-agenda-query-generic-cmd "+"))
|
||||||
|
|
||||||
|
(defun org-agenda-query-or-cmd ()
|
||||||
|
"Activate query manipulation, initially using the OR (|) operator."
|
||||||
|
(interactive)
|
||||||
|
(org-agenda-query-generic-cmd "|"))
|
||||||
|
|
||||||
|
(defun org-agenda-query-not-cmd ()
|
||||||
|
"Activate query manipulation, initially using the NOT (-) operator."
|
||||||
|
(interactive)
|
||||||
|
(org-agenda-query-generic-cmd "-"))
|
||||||
|
|
@ -1,328 +0,0 @@
|
||||||
--- org-vendor/org.el 2008-01-06 10:30:26.000000000 -0500
|
|
||||||
+++ org/org.el 2008-01-12 17:19:15.000000000 -0500
|
|
||||||
@@ -15078,7 +15078,8 @@
|
|
||||||
(let ((org-last-tags-completion-table
|
|
||||||
(org-global-tags-completion-table)))
|
|
||||||
(setq match (completing-read
|
|
||||||
- "Match: " 'org-tags-completion-function nil nil nil
|
|
||||||
+ "Match: " 'org-tags-completion-function nil nil
|
|
||||||
+ org-agenda-query-string
|
|
||||||
'org-tags-history))))
|
|
||||||
|
|
||||||
;; Parse the string and create a lisp form
|
|
||||||
@@ -18812,6 +18813,7 @@
|
|
||||||
(defvar org-agenda-follow-mode nil)
|
|
||||||
(defvar org-agenda-show-log nil)
|
|
||||||
(defvar org-agenda-redo-command nil)
|
|
||||||
+(defvar org-agenda-query-string nil)
|
|
||||||
(defvar org-agenda-mode-hook nil)
|
|
||||||
(defvar org-agenda-type nil)
|
|
||||||
(defvar org-agenda-force-single-file nil)
|
|
||||||
@@ -18947,6 +18949,10 @@
|
|
||||||
(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later)
|
|
||||||
(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier)
|
|
||||||
(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
|
|
||||||
+(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
|
|
||||||
+(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
|
|
||||||
+(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
|
|
||||||
+(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
|
|
||||||
|
|
||||||
(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
|
|
||||||
"Local keymap for agenda entries from Org-mode.")
|
|
||||||
@@ -20423,9 +20429,10 @@
|
|
||||||
(setq matcher (org-make-tags-matcher match)
|
|
||||||
match (car matcher) matcher (cdr matcher))
|
|
||||||
(org-prepare-agenda (concat "TAGS " match))
|
|
||||||
+ (setq org-agenda-query-string match)
|
|
||||||
(setq org-agenda-redo-command
|
|
||||||
(list 'org-tags-view (list 'quote todo-only)
|
|
||||||
- (list 'if 'current-prefix-arg nil match)))
|
|
||||||
+ (list 'if 'current-prefix-arg nil 'org-agenda-query-string)))
|
|
||||||
(setq files (org-agenda-files)
|
|
||||||
rtnall nil)
|
|
||||||
(while (setq file (pop files))
|
|
||||||
@@ -20461,7 +20468,7 @@
|
|
||||||
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
|
|
||||||
(setq pos (point))
|
|
||||||
(unless org-agenda-multi
|
|
||||||
- (insert "Press `C-u r' to search again with new search string\n"))
|
|
||||||
+ (insert "Press `C-u r' to enter new search string; use `/;\\=' to adjust interactively\n"))
|
|
||||||
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
|
|
||||||
(when rtnall
|
|
||||||
(insert (org-finalize-agenda-entries rtnall) "\n"))
|
|
||||||
@@ -20471,6 +20478,275 @@
|
|
||||||
(org-finalize-agenda)
|
|
||||||
(setq buffer-read-only t)))
|
|
||||||
|
|
||||||
+;;; Agenda interactive query manipulation
|
|
||||||
+
|
|
||||||
+(defcustom org-agenda-query-selection-single-key t
|
|
||||||
+ "Non-nil means, query manipulation exits after first change.
|
|
||||||
+When nil, you have to press RET to exit it.
|
|
||||||
+During query selection, you can toggle this flag with `C-c'.
|
|
||||||
+This variable can also have the value `expert'. In this case, the window
|
|
||||||
+displaying the tags menu is not even shown, until you press C-c again."
|
|
||||||
+ :group 'org-agenda
|
|
||||||
+ :type '(choice
|
|
||||||
+ (const :tag "No" nil)
|
|
||||||
+ (const :tag "Yes" t)
|
|
||||||
+ (const :tag "Expert" expert)))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-selection (current op table &optional todo-table)
|
|
||||||
+ "Fast query manipulation with single keys.
|
|
||||||
+CURRENT is the current query string, OP is the initial
|
|
||||||
+operator (one of \"+|-=\"), TABLE is an alist of tags and
|
|
||||||
+corresponding keys, possibly with grouping information.
|
|
||||||
+TODO-TABLE is a similar table with TODO keywords, should these
|
|
||||||
+have keys assigned to them. If the keys are nil, a-z are
|
|
||||||
+automatically assigned. Returns the new query string, or nil to
|
|
||||||
+not change the current one."
|
|
||||||
+ (let* ((fulltable (append table todo-table))
|
|
||||||
+ (maxlen (apply 'max (mapcar
|
|
||||||
+ (lambda (x)
|
|
||||||
+ (if (stringp (car x)) (string-width (car x)) 0))
|
|
||||||
+ fulltable)))
|
|
||||||
+ (fwidth (+ maxlen 3 1 3))
|
|
||||||
+ (ncol (/ (- (window-width) 4) fwidth))
|
|
||||||
+ (expert (eq org-agenda-query-selection-single-key 'expert))
|
|
||||||
+ (exit-after-next org-agenda-query-selection-single-key)
|
|
||||||
+ (done-keywords org-done-keywords)
|
|
||||||
+ tbl char cnt e groups ingroup
|
|
||||||
+ tg c2 c c1 ntable rtn)
|
|
||||||
+ (save-window-excursion
|
|
||||||
+ (if expert
|
|
||||||
+ (set-buffer (get-buffer-create " *Org tags*"))
|
|
||||||
+ (delete-other-windows)
|
|
||||||
+ (split-window-vertically)
|
|
||||||
+ (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
|
|
||||||
+ (erase-buffer)
|
|
||||||
+ (org-set-local 'org-done-keywords done-keywords)
|
|
||||||
+ (insert "Query: " current "\n")
|
|
||||||
+ (org-agenda-query-op-line op)
|
|
||||||
+ (insert "\n\n")
|
|
||||||
+ (org-fast-tag-show-exit exit-after-next)
|
|
||||||
+ (setq tbl fulltable char ?a cnt 0)
|
|
||||||
+ (while (setq e (pop tbl))
|
|
||||||
+ (cond
|
|
||||||
+ ((equal e '(:startgroup))
|
|
||||||
+ (push '() groups) (setq ingroup t)
|
|
||||||
+ (when (not (= cnt 0))
|
|
||||||
+ (setq cnt 0)
|
|
||||||
+ (insert "\n"))
|
|
||||||
+ (insert "{ "))
|
|
||||||
+ ((equal e '(:endgroup))
|
|
||||||
+ (setq ingroup nil cnt 0)
|
|
||||||
+ (insert "}\n"))
|
|
||||||
+ (t
|
|
||||||
+ (setq tg (car e) c2 nil)
|
|
||||||
+ (if (cdr e)
|
|
||||||
+ (setq c (cdr e))
|
|
||||||
+ ;; automatically assign a character.
|
|
||||||
+ (setq c1 (string-to-char
|
|
||||||
+ (downcase (substring
|
|
||||||
+ tg (if (= (string-to-char tg) ?@) 1 0)))))
|
|
||||||
+ (if (or (rassoc c1 ntable) (rassoc c1 table))
|
|
||||||
+ (while (or (rassoc char ntable) (rassoc char table))
|
|
||||||
+ (setq char (1+ char)))
|
|
||||||
+ (setq c2 c1))
|
|
||||||
+ (setq c (or c2 char)))
|
|
||||||
+ (if ingroup (push tg (car groups)))
|
|
||||||
+ (setq tg (org-add-props tg nil 'face
|
|
||||||
+ (cond
|
|
||||||
+ ((not (assoc tg table))
|
|
||||||
+ (org-get-todo-face tg))
|
|
||||||
+ (t nil))))
|
|
||||||
+ (if (and (= cnt 0) (not ingroup)) (insert " "))
|
|
||||||
+ (insert "[" c "] " tg (make-string
|
|
||||||
+ (- fwidth 4 (length tg)) ?\ ))
|
|
||||||
+ (push (cons tg c) ntable)
|
|
||||||
+ (when (= (setq cnt (1+ cnt)) ncol)
|
|
||||||
+ (insert "\n")
|
|
||||||
+ (if ingroup (insert " "))
|
|
||||||
+ (setq cnt 0)))))
|
|
||||||
+ (setq ntable (nreverse ntable))
|
|
||||||
+ (insert "\n")
|
|
||||||
+ (goto-char (point-min))
|
|
||||||
+ (if (and (not expert) (fboundp 'fit-window-to-buffer))
|
|
||||||
+ (fit-window-to-buffer))
|
|
||||||
+ (setq rtn
|
|
||||||
+ (catch 'exit
|
|
||||||
+ (while t
|
|
||||||
+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
|
|
||||||
+ (if groups " [!] no groups" " [!]groups")
|
|
||||||
+ (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
|
||||||
+ (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
|
||||||
+ (cond
|
|
||||||
+ ((= c ?\r) (throw 'exit t))
|
|
||||||
+ ((= c ?!)
|
|
||||||
+ (setq groups (not groups))
|
|
||||||
+ (goto-char (point-min))
|
|
||||||
+ (while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
|
||||||
+ ((= c ?\C-c)
|
|
||||||
+ (if (not expert)
|
|
||||||
+ (org-fast-tag-show-exit
|
|
||||||
+ (setq exit-after-next (not exit-after-next)))
|
|
||||||
+ (setq expert nil)
|
|
||||||
+ (delete-other-windows)
|
|
||||||
+ (split-window-vertically)
|
|
||||||
+ (org-switch-to-buffer-other-window " *Org tags*")
|
|
||||||
+ (and (fboundp 'fit-window-to-buffer)
|
|
||||||
+ (fit-window-to-buffer))))
|
|
||||||
+ ((or (= c ?\C-g)
|
|
||||||
+ (and (= c ?q) (not (rassoc c ntable))))
|
|
||||||
+ (setq quit-flag t))
|
|
||||||
+ ((= c ?\ )
|
|
||||||
+ (setq current "")
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ((= c ?\[) ; clear left
|
|
||||||
+ (org-agenda-query-decompose current)
|
|
||||||
+ (setq current (concat "/" (match-string 2 current)))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ((= c ?\]) ; clear right
|
|
||||||
+ (org-agenda-query-decompose current)
|
|
||||||
+ (setq current (match-string 1 current))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ((= c ?\t)
|
|
||||||
+ (condition-case nil
|
|
||||||
+ (setq current (read-string "Query: " current))
|
|
||||||
+ (quit))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ;; operators
|
|
||||||
+ ((or (= c ?/) (= c ?+)) (setq op "+"))
|
|
||||||
+ ((or (= c ?\;) (= c ?|)) (setq op "|"))
|
|
||||||
+ ((or (= c ?\\) (= c ?-)) (setq op "-"))
|
|
||||||
+ ((= c ?=) (setq op "="))
|
|
||||||
+ ;; todos
|
|
||||||
+ ((setq e (rassoc c todo-table) tg (car e))
|
|
||||||
+ (setq current (org-agenda-query-manip
|
|
||||||
+ current op groups 'todo tg))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ;; tags
|
|
||||||
+ ((setq e (rassoc c ntable) tg (car e))
|
|
||||||
+ (setq current (org-agenda-query-manip
|
|
||||||
+ current op groups 'tag tg))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now))))
|
|
||||||
+ (if (eq exit-after-next 'now) (throw 'exit t))
|
|
||||||
+ (goto-char (point-min))
|
|
||||||
+ (beginning-of-line 1)
|
|
||||||
+ (delete-region (point) (point-at-eol))
|
|
||||||
+ (insert "Query: " current)
|
|
||||||
+ (beginning-of-line 2)
|
|
||||||
+ (delete-region (point) (point-at-eol))
|
|
||||||
+ (org-agenda-query-op-line op)
|
|
||||||
+ (goto-char (point-min)))))
|
|
||||||
+ (if rtn current nil))))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-op-line (op)
|
|
||||||
+ (insert "Operator: "
|
|
||||||
+ (org-agenda-query-op-entry (equal op "+") "/+" "and")
|
|
||||||
+ (org-agenda-query-op-entry (equal op "|") ";|" "or")
|
|
||||||
+ (org-agenda-query-op-entry (equal op "-") "\\-" "not")
|
|
||||||
+ (org-agenda-query-op-entry (equal op "=") "=" "clear")))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-op-entry (matchp chars str)
|
|
||||||
+ (if matchp
|
|
||||||
+ (org-add-props (format "[%s %s] " chars (upcase str))
|
|
||||||
+ nil 'face 'org-todo)
|
|
||||||
+ (format "[%s]%s " chars str)))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-decompose (current)
|
|
||||||
+ (string-match "\\([^/]*\\)/?\\(.*\\)" current))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-clear (current prefix tag)
|
|
||||||
+ (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
|
|
||||||
+ (replace-match "" t t current)
|
|
||||||
+ current))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-manip (current op groups kind tag)
|
|
||||||
+ "Apply an operator to a query string and a tag.
|
|
||||||
+CURRENT is the current query string, OP is the operator, GROUPS is a
|
|
||||||
+list of lists of tags that are mutually exclusive. KIND is 'tag for a
|
|
||||||
+regular tag, or 'todo for a TODO keyword, and TAG is the tag or
|
|
||||||
+keyword string."
|
|
||||||
+ ;; If this tag is already in query string, remove it.
|
|
||||||
+ (setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
|
|
||||||
+ (if (equal op "=") current
|
|
||||||
+ ;; When using AND, also remove mutually exclusive tags.
|
|
||||||
+ (if (equal op "+")
|
|
||||||
+ (loop for g in groups do
|
|
||||||
+ (if (member tag g)
|
|
||||||
+ (mapc (lambda (x)
|
|
||||||
+ (setq current
|
|
||||||
+ (org-agenda-query-clear current "\\+" x)))
|
|
||||||
+ g))))
|
|
||||||
+ ;; Decompose current query into q1 (tags) and q2 (TODOs).
|
|
||||||
+ (org-agenda-query-decompose current)
|
|
||||||
+ (let* ((q1 (match-string 1 current))
|
|
||||||
+ (q2 (match-string 2 current)))
|
|
||||||
+ (cond
|
|
||||||
+ ((eq kind 'tag)
|
|
||||||
+ (concat q1 op tag "/" q2))
|
|
||||||
+ ;; It's a TODO; when using AND, drop all other TODOs.
|
|
||||||
+ ((equal op "+")
|
|
||||||
+ (concat q1 "/+" tag))
|
|
||||||
+ (t
|
|
||||||
+ (concat q1 "/" q2 op tag))))))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-global-todo-keys (&optional files)
|
|
||||||
+ "Return alist of all TODO keywords and their fast keys, in all FILES."
|
|
||||||
+ (let (alist)
|
|
||||||
+ (unless (and files (car files))
|
|
||||||
+ (setq files (org-agenda-files)))
|
|
||||||
+ (save-excursion
|
|
||||||
+ (loop for f in files do
|
|
||||||
+ (set-buffer (find-file-noselect f))
|
|
||||||
+ (loop for k in org-todo-key-alist do
|
|
||||||
+ (setq alist (org-agenda-query-merge-todo-key
|
|
||||||
+ alist k)))))
|
|
||||||
+ alist))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-merge-todo-key (alist entry)
|
|
||||||
+ (let (e)
|
|
||||||
+ (cond
|
|
||||||
+ ;; if this is not a keyword (:startgroup, etc), ignore it
|
|
||||||
+ ((not (stringp (car entry))))
|
|
||||||
+ ;; if keyword already exists, replace char if it's null
|
|
||||||
+ ((setq e (assoc (car entry) alist))
|
|
||||||
+ (when (null (cdr e)) (setcdr e (cdr entry))))
|
|
||||||
+ ;; if char already exists, prepend keyword but drop char
|
|
||||||
+ ((rassoc (cdr entry) alist)
|
|
||||||
+ (error "TRACE POSITION 2")
|
|
||||||
+ (setq alist (cons (cons (car entry) nil) alist)))
|
|
||||||
+ ;; else, prepend COPY of entry
|
|
||||||
+ (t
|
|
||||||
+ (setq alist (cons (cons (car entry) (cdr entry)) alist)))))
|
|
||||||
+ alist)
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-generic-cmd (op)
|
|
||||||
+ "Activate query manipulation with OP as initial operator."
|
|
||||||
+ (let ((q (org-agenda-query-selection org-agenda-query-string op
|
|
||||||
+ org-tag-alist
|
|
||||||
+ (org-agenda-query-global-todo-keys))))
|
|
||||||
+ (when q
|
|
||||||
+ (setq org-agenda-query-string q)
|
|
||||||
+ (org-agenda-redo))))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-clear-cmd ()
|
|
||||||
+ "Activate query manipulation, to clear a tag from the string."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "="))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-and-cmd ()
|
|
||||||
+ "Activate query manipulation, initially using the AND (+) operator."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "+"))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-or-cmd ()
|
|
||||||
+ "Activate query manipulation, initially using the OR (|) operator."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "|"))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-not-cmd ()
|
|
||||||
+ "Activate query manipulation, initially using the NOT (-) operator."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "-"))
|
|
||||||
+
|
|
||||||
;;; Agenda Finding stuck projects
|
|
||||||
|
|
||||||
(defvar org-agenda-skip-regexp nil
|
|
||||||
|
|
@ -1,328 +0,0 @@
|
||||||
--- org-vendor/org.el 2008-01-06 10:30:26.000000000 -0500
|
|
||||||
+++ org/org.el 2008-01-12 17:19:15.000000000 -0500
|
|
||||||
@@ -15078,7 +15078,8 @@
|
|
||||||
(let ((org-last-tags-completion-table
|
|
||||||
(org-global-tags-completion-table)))
|
|
||||||
(setq match (completing-read
|
|
||||||
- "Match: " 'org-tags-completion-function nil nil nil
|
|
||||||
+ "Match: " 'org-tags-completion-function nil nil
|
|
||||||
+ org-agenda-query-string
|
|
||||||
'org-tags-history))))
|
|
||||||
|
|
||||||
;; Parse the string and create a lisp form
|
|
||||||
@@ -18812,6 +18813,7 @@
|
|
||||||
(defvar org-agenda-follow-mode nil)
|
|
||||||
(defvar org-agenda-show-log nil)
|
|
||||||
(defvar org-agenda-redo-command nil)
|
|
||||||
+(defvar org-agenda-query-string nil)
|
|
||||||
(defvar org-agenda-mode-hook nil)
|
|
||||||
(defvar org-agenda-type nil)
|
|
||||||
(defvar org-agenda-force-single-file nil)
|
|
||||||
@@ -18947,6 +18949,10 @@
|
|
||||||
(org-defkey org-agenda-mode-map [(right)] 'org-agenda-later)
|
|
||||||
(org-defkey org-agenda-mode-map [(left)] 'org-agenda-earlier)
|
|
||||||
(org-defkey org-agenda-mode-map "\C-c\C-x\C-c" 'org-agenda-columns)
|
|
||||||
+(org-defkey org-agenda-mode-map "=" 'org-agenda-query-clear-cmd)
|
|
||||||
+(org-defkey org-agenda-mode-map "/" 'org-agenda-query-and-cmd)
|
|
||||||
+(org-defkey org-agenda-mode-map ";" 'org-agenda-query-or-cmd)
|
|
||||||
+(org-defkey org-agenda-mode-map "\\" 'org-agenda-query-not-cmd)
|
|
||||||
|
|
||||||
(defvar org-agenda-keymap (copy-keymap org-agenda-mode-map)
|
|
||||||
"Local keymap for agenda entries from Org-mode.")
|
|
||||||
@@ -20423,9 +20429,10 @@
|
|
||||||
(setq matcher (org-make-tags-matcher match)
|
|
||||||
match (car matcher) matcher (cdr matcher))
|
|
||||||
(org-prepare-agenda (concat "TAGS " match))
|
|
||||||
+ (setq org-agenda-query-string match)
|
|
||||||
(setq org-agenda-redo-command
|
|
||||||
(list 'org-tags-view (list 'quote todo-only)
|
|
||||||
- (list 'if 'current-prefix-arg nil match)))
|
|
||||||
+ (list 'if 'current-prefix-arg nil 'org-agenda-query-string)))
|
|
||||||
(setq files (org-agenda-files)
|
|
||||||
rtnall nil)
|
|
||||||
(while (setq file (pop files))
|
|
||||||
@@ -20461,7 +20468,7 @@
|
|
||||||
(add-text-properties pos (1- (point)) (list 'face 'org-warning))
|
|
||||||
(setq pos (point))
|
|
||||||
(unless org-agenda-multi
|
|
||||||
- (insert "Press `C-u r' to search again with new search string\n"))
|
|
||||||
+ (insert "Press `C-u r' to enter new search string; use `/;\\=' to adjust interactively\n"))
|
|
||||||
(add-text-properties pos (1- (point)) (list 'face 'org-agenda-structure)))
|
|
||||||
(when rtnall
|
|
||||||
(insert (org-finalize-agenda-entries rtnall) "\n"))
|
|
||||||
@@ -20471,6 +20478,275 @@
|
|
||||||
(org-finalize-agenda)
|
|
||||||
(setq buffer-read-only t)))
|
|
||||||
|
|
||||||
+;;; Agenda interactive query manipulation
|
|
||||||
+
|
|
||||||
+(defcustom org-agenda-query-selection-single-key t
|
|
||||||
+ "Non-nil means, query manipulation exits after first change.
|
|
||||||
+When nil, you have to press RET to exit it.
|
|
||||||
+During query selection, you can toggle this flag with `C-c'.
|
|
||||||
+This variable can also have the value `expert'. In this case, the window
|
|
||||||
+displaying the tags menu is not even shown, until you press C-c again."
|
|
||||||
+ :group 'org-agenda
|
|
||||||
+ :type '(choice
|
|
||||||
+ (const :tag "No" nil)
|
|
||||||
+ (const :tag "Yes" t)
|
|
||||||
+ (const :tag "Expert" expert)))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-selection (current op table &optional todo-table)
|
|
||||||
+ "Fast query manipulation with single keys.
|
|
||||||
+CURRENT is the current query string, OP is the initial
|
|
||||||
+operator (one of \"+|-=\"), TABLE is an alist of tags and
|
|
||||||
+corresponding keys, possibly with grouping information.
|
|
||||||
+TODO-TABLE is a similar table with TODO keywords, should these
|
|
||||||
+have keys assigned to them. If the keys are nil, a-z are
|
|
||||||
+automatically assigned. Returns the new query string, or nil to
|
|
||||||
+not change the current one."
|
|
||||||
+ (let* ((fulltable (append table todo-table))
|
|
||||||
+ (maxlen (apply 'max (mapcar
|
|
||||||
+ (lambda (x)
|
|
||||||
+ (if (stringp (car x)) (string-width (car x)) 0))
|
|
||||||
+ fulltable)))
|
|
||||||
+ (fwidth (+ maxlen 3 1 3))
|
|
||||||
+ (ncol (/ (- (window-width) 4) fwidth))
|
|
||||||
+ (expert (eq org-agenda-query-selection-single-key 'expert))
|
|
||||||
+ (exit-after-next org-agenda-query-selection-single-key)
|
|
||||||
+ (done-keywords org-done-keywords)
|
|
||||||
+ tbl char cnt e groups ingroup
|
|
||||||
+ tg c2 c c1 ntable rtn)
|
|
||||||
+ (save-window-excursion
|
|
||||||
+ (if expert
|
|
||||||
+ (set-buffer (get-buffer-create " *Org tags*"))
|
|
||||||
+ (delete-other-windows)
|
|
||||||
+ (split-window-vertically)
|
|
||||||
+ (org-switch-to-buffer-other-window (get-buffer-create " *Org tags*")))
|
|
||||||
+ (erase-buffer)
|
|
||||||
+ (org-set-local 'org-done-keywords done-keywords)
|
|
||||||
+ (insert "Query: " current "\n")
|
|
||||||
+ (org-agenda-query-op-line op)
|
|
||||||
+ (insert "\n\n")
|
|
||||||
+ (org-fast-tag-show-exit exit-after-next)
|
|
||||||
+ (setq tbl fulltable char ?a cnt 0)
|
|
||||||
+ (while (setq e (pop tbl))
|
|
||||||
+ (cond
|
|
||||||
+ ((equal e '(:startgroup))
|
|
||||||
+ (push '() groups) (setq ingroup t)
|
|
||||||
+ (when (not (= cnt 0))
|
|
||||||
+ (setq cnt 0)
|
|
||||||
+ (insert "\n"))
|
|
||||||
+ (insert "{ "))
|
|
||||||
+ ((equal e '(:endgroup))
|
|
||||||
+ (setq ingroup nil cnt 0)
|
|
||||||
+ (insert "}\n"))
|
|
||||||
+ (t
|
|
||||||
+ (setq tg (car e) c2 nil)
|
|
||||||
+ (if (cdr e)
|
|
||||||
+ (setq c (cdr e))
|
|
||||||
+ ;; automatically assign a character.
|
|
||||||
+ (setq c1 (string-to-char
|
|
||||||
+ (downcase (substring
|
|
||||||
+ tg (if (= (string-to-char tg) ?@) 1 0)))))
|
|
||||||
+ (if (or (rassoc c1 ntable) (rassoc c1 table))
|
|
||||||
+ (while (or (rassoc char ntable) (rassoc char table))
|
|
||||||
+ (setq char (1+ char)))
|
|
||||||
+ (setq c2 c1))
|
|
||||||
+ (setq c (or c2 char)))
|
|
||||||
+ (if ingroup (push tg (car groups)))
|
|
||||||
+ (setq tg (org-add-props tg nil 'face
|
|
||||||
+ (cond
|
|
||||||
+ ((not (assoc tg table))
|
|
||||||
+ (org-get-todo-face tg))
|
|
||||||
+ (t nil))))
|
|
||||||
+ (if (and (= cnt 0) (not ingroup)) (insert " "))
|
|
||||||
+ (insert "[" c "] " tg (make-string
|
|
||||||
+ (- fwidth 4 (length tg)) ?\ ))
|
|
||||||
+ (push (cons tg c) ntable)
|
|
||||||
+ (when (= (setq cnt (1+ cnt)) ncol)
|
|
||||||
+ (insert "\n")
|
|
||||||
+ (if ingroup (insert " "))
|
|
||||||
+ (setq cnt 0)))))
|
|
||||||
+ (setq ntable (nreverse ntable))
|
|
||||||
+ (insert "\n")
|
|
||||||
+ (goto-char (point-min))
|
|
||||||
+ (if (and (not expert) (fboundp 'fit-window-to-buffer))
|
|
||||||
+ (fit-window-to-buffer))
|
|
||||||
+ (setq rtn
|
|
||||||
+ (catch 'exit
|
|
||||||
+ (while t
|
|
||||||
+ (message "[a-z..]:Toggle [SPC]:clear [RET]:accept [TAB]:free%s%s"
|
|
||||||
+ (if groups " [!] no groups" " [!]groups")
|
|
||||||
+ (if expert " [C-c]:window" (if exit-after-next " [C-c]:single" " [C-c]:multi")))
|
|
||||||
+ (setq c (let ((inhibit-quit t)) (read-char-exclusive)))
|
|
||||||
+ (cond
|
|
||||||
+ ((= c ?\r) (throw 'exit t))
|
|
||||||
+ ((= c ?!)
|
|
||||||
+ (setq groups (not groups))
|
|
||||||
+ (goto-char (point-min))
|
|
||||||
+ (while (re-search-forward "[{}]" nil t) (replace-match " ")))
|
|
||||||
+ ((= c ?\C-c)
|
|
||||||
+ (if (not expert)
|
|
||||||
+ (org-fast-tag-show-exit
|
|
||||||
+ (setq exit-after-next (not exit-after-next)))
|
|
||||||
+ (setq expert nil)
|
|
||||||
+ (delete-other-windows)
|
|
||||||
+ (split-window-vertically)
|
|
||||||
+ (org-switch-to-buffer-other-window " *Org tags*")
|
|
||||||
+ (and (fboundp 'fit-window-to-buffer)
|
|
||||||
+ (fit-window-to-buffer))))
|
|
||||||
+ ((or (= c ?\C-g)
|
|
||||||
+ (and (= c ?q) (not (rassoc c ntable))))
|
|
||||||
+ (setq quit-flag t))
|
|
||||||
+ ((= c ?\ )
|
|
||||||
+ (setq current "")
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ((= c ?\[) ; clear left
|
|
||||||
+ (org-agenda-query-decompose current)
|
|
||||||
+ (setq current (concat "/" (match-string 2 current)))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ((= c ?\]) ; clear right
|
|
||||||
+ (org-agenda-query-decompose current)
|
|
||||||
+ (setq current (match-string 1 current))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ((= c ?\t)
|
|
||||||
+ (condition-case nil
|
|
||||||
+ (setq current (read-string "Query: " current))
|
|
||||||
+ (quit))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ;; operators
|
|
||||||
+ ((or (= c ?/) (= c ?+)) (setq op "+"))
|
|
||||||
+ ((or (= c ?\;) (= c ?|)) (setq op "|"))
|
|
||||||
+ ((or (= c ?\\) (= c ?-)) (setq op "-"))
|
|
||||||
+ ((= c ?=) (setq op "="))
|
|
||||||
+ ;; todos
|
|
||||||
+ ((setq e (rassoc c todo-table) tg (car e))
|
|
||||||
+ (setq current (org-agenda-query-manip
|
|
||||||
+ current op groups 'todo tg))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now)))
|
|
||||||
+ ;; tags
|
|
||||||
+ ((setq e (rassoc c ntable) tg (car e))
|
|
||||||
+ (setq current (org-agenda-query-manip
|
|
||||||
+ current op groups 'tag tg))
|
|
||||||
+ (if exit-after-next (setq exit-after-next 'now))))
|
|
||||||
+ (if (eq exit-after-next 'now) (throw 'exit t))
|
|
||||||
+ (goto-char (point-min))
|
|
||||||
+ (beginning-of-line 1)
|
|
||||||
+ (delete-region (point) (point-at-eol))
|
|
||||||
+ (insert "Query: " current)
|
|
||||||
+ (beginning-of-line 2)
|
|
||||||
+ (delete-region (point) (point-at-eol))
|
|
||||||
+ (org-agenda-query-op-line op)
|
|
||||||
+ (goto-char (point-min)))))
|
|
||||||
+ (if rtn current nil))))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-op-line (op)
|
|
||||||
+ (insert "Operator: "
|
|
||||||
+ (org-agenda-query-op-entry (equal op "+") "/+" "and")
|
|
||||||
+ (org-agenda-query-op-entry (equal op "|") ";|" "or")
|
|
||||||
+ (org-agenda-query-op-entry (equal op "-") "\\-" "not")
|
|
||||||
+ (org-agenda-query-op-entry (equal op "=") "=" "clear")))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-op-entry (matchp chars str)
|
|
||||||
+ (if matchp
|
|
||||||
+ (org-add-props (format "[%s %s] " chars (upcase str))
|
|
||||||
+ nil 'face 'org-todo)
|
|
||||||
+ (format "[%s]%s " chars str)))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-decompose (current)
|
|
||||||
+ (string-match "\\([^/]*\\)/?\\(.*\\)" current))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-clear (current prefix tag)
|
|
||||||
+ (if (string-match (concat prefix "\\b" (regexp-quote tag) "\\b") current)
|
|
||||||
+ (replace-match "" t t current)
|
|
||||||
+ current))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-manip (current op groups kind tag)
|
|
||||||
+ "Apply an operator to a query string and a tag.
|
|
||||||
+CURRENT is the current query string, OP is the operator, GROUPS is a
|
|
||||||
+list of lists of tags that are mutually exclusive. KIND is 'tag for a
|
|
||||||
+regular tag, or 'todo for a TODO keyword, and TAG is the tag or
|
|
||||||
+keyword string."
|
|
||||||
+ ;; If this tag is already in query string, remove it.
|
|
||||||
+ (setq current (org-agenda-query-clear current "[-\\+&|]?" tag))
|
|
||||||
+ (if (equal op "=") current
|
|
||||||
+ ;; When using AND, also remove mutually exclusive tags.
|
|
||||||
+ (if (equal op "+")
|
|
||||||
+ (loop for g in groups do
|
|
||||||
+ (if (member tag g)
|
|
||||||
+ (mapc (lambda (x)
|
|
||||||
+ (setq current
|
|
||||||
+ (org-agenda-query-clear current "\\+" x)))
|
|
||||||
+ g))))
|
|
||||||
+ ;; Decompose current query into q1 (tags) and q2 (TODOs).
|
|
||||||
+ (org-agenda-query-decompose current)
|
|
||||||
+ (let* ((q1 (match-string 1 current))
|
|
||||||
+ (q2 (match-string 2 current)))
|
|
||||||
+ (cond
|
|
||||||
+ ((eq kind 'tag)
|
|
||||||
+ (concat q1 op tag "/" q2))
|
|
||||||
+ ;; It's a TODO; when using AND, drop all other TODOs.
|
|
||||||
+ ((equal op "+")
|
|
||||||
+ (concat q1 "/+" tag))
|
|
||||||
+ (t
|
|
||||||
+ (concat q1 "/" q2 op tag))))))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-global-todo-keys (&optional files)
|
|
||||||
+ "Return alist of all TODO keywords and their fast keys, in all FILES."
|
|
||||||
+ (let (alist)
|
|
||||||
+ (unless (and files (car files))
|
|
||||||
+ (setq files (org-agenda-files)))
|
|
||||||
+ (save-excursion
|
|
||||||
+ (loop for f in files do
|
|
||||||
+ (set-buffer (find-file-noselect f))
|
|
||||||
+ (loop for k in org-todo-key-alist do
|
|
||||||
+ (setq alist (org-agenda-query-merge-todo-key
|
|
||||||
+ alist k)))))
|
|
||||||
+ alist))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-merge-todo-key (alist entry)
|
|
||||||
+ (let (e)
|
|
||||||
+ (cond
|
|
||||||
+ ;; if this is not a keyword (:startgroup, etc), ignore it
|
|
||||||
+ ((not (stringp (car entry))))
|
|
||||||
+ ;; if keyword already exists, replace char if it's null
|
|
||||||
+ ((setq e (assoc (car entry) alist))
|
|
||||||
+ (when (null (cdr e)) (setcdr e (cdr entry))))
|
|
||||||
+ ;; if char already exists, prepend keyword but drop char
|
|
||||||
+ ((rassoc (cdr entry) alist)
|
|
||||||
+ (error "TRACE POSITION 2")
|
|
||||||
+ (setq alist (cons (cons (car entry) nil) alist)))
|
|
||||||
+ ;; else, prepend COPY of entry
|
|
||||||
+ (t
|
|
||||||
+ (setq alist (cons (cons (car entry) (cdr entry)) alist)))))
|
|
||||||
+ alist)
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-generic-cmd (op)
|
|
||||||
+ "Activate query manipulation with OP as initial operator."
|
|
||||||
+ (let ((q (org-agenda-query-selection org-agenda-query-string op
|
|
||||||
+ org-tag-alist
|
|
||||||
+ (org-agenda-query-global-todo-keys))))
|
|
||||||
+ (when q
|
|
||||||
+ (setq org-agenda-query-string q)
|
|
||||||
+ (org-agenda-redo))))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-clear-cmd ()
|
|
||||||
+ "Activate query manipulation, to clear a tag from the string."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "="))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-and-cmd ()
|
|
||||||
+ "Activate query manipulation, initially using the AND (+) operator."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "+"))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-or-cmd ()
|
|
||||||
+ "Activate query manipulation, initially using the OR (|) operator."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "|"))
|
|
||||||
+
|
|
||||||
+(defun org-agenda-query-not-cmd ()
|
|
||||||
+ "Activate query manipulation, initially using the NOT (-) operator."
|
|
||||||
+ (interactive)
|
|
||||||
+ (org-agenda-query-generic-cmd "-"))
|
|
||||||
+
|
|
||||||
;;; Agenda Finding stuck projects
|
|
||||||
|
|
||||||
(defvar org-agenda-skip-regexp nil
|
|
||||||
File diff suppressed because it is too large
Load Diff
File diff suppressed because it is too large
Load Diff
3
org.el
3
org.el
|
|
@ -21239,9 +21239,10 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
|
||||||
(setq matcher (org-make-tags-matcher match)
|
(setq matcher (org-make-tags-matcher match)
|
||||||
match (car matcher) matcher (cdr matcher))
|
match (car matcher) matcher (cdr matcher))
|
||||||
(org-prepare-agenda (concat "TAGS " match))
|
(org-prepare-agenda (concat "TAGS " match))
|
||||||
|
(setq org-agenda-query-string match)
|
||||||
(setq org-agenda-redo-command
|
(setq org-agenda-redo-command
|
||||||
(list 'org-tags-view (list 'quote todo-only)
|
(list 'org-tags-view (list 'quote todo-only)
|
||||||
(list 'if 'current-prefix-arg nil match)))
|
(list 'if 'current-prefix-arg nil 'org-agenda-query-string)))
|
||||||
(setq files (org-agenda-files)
|
(setq files (org-agenda-files)
|
||||||
rtnall nil)
|
rtnall nil)
|
||||||
(while (setq file (pop files))
|
(while (setq file (pop files))
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue