Implement group tags
* org-agenda.el (org-tags-view): Set the matcher after preparing the agenda, as `org-tag-groups-alist-for-agenda' might be needed. (org-agenda-filter-make-matcher): New parameter `filter' and `type'. Handle group tags. (org-agenda-filter-expand-tags): New function. (org-agenda-filter-apply): Handle group tags. * org.el (org-blank-before-new-entry): Tiny docstring fix. (org-tag-alist-for-agenda): Add docstring. (org-tag-groups-alist-for-agenda): New global variable. (org-tag-groups-alist): New buffer-local variable. (org-tag-alist, org-tag-persistent-alist): Handle :grouptags. (org-group-tags): New option. (org-toggle-group-tags): New command. (org-mode-map): Bind `org-toggle-group-tags' to `C-c C-x q'. (org-set-regexps-and-options-for-tags): New function, factored out from `org-set-regexps-and-options'. (org-set-regexps-and-options): Don't handle tags, they are now handled separately by `org-set-regexps-and-options-for-tags'. (org-assign-fast-keys): Handle :grouptags. (org-mode): Use `org-set-regexps-and-options-for-tags' on top of `org-set-regexps-and-options'. (org-fontify-meta-lines-and-blocks-1): Fontify group tags. (org-make-tags-matcher): Expand group tags in the matcher. (org-tags-expand): New function. (org-tags-completion-function): Tiny code clean up. (org-set-current-tags-overlay): Add a docstring. (org-fast-tag-selection): Highlight group tags. (org-agenda-prepare-buffers): Set `org-tag-alist-for-agenda' and `org-tag-groups-alist-for-agenda'. Don't uniquify `org-tag-alist-for-agenda' as we may need the grouping information for filtering in the agenda buffer. (org-uniquify-alist): New function. * org-pcomplete.el (pcomplete/org-mode/file-option/tags): Handle :grouptags. * org-faces.el (mode-line): New face for group tags.
This commit is contained in:
Bastien Guerry
parent
225289c2db
commit
a9880a7710
|
|
@ -4753,8 +4753,6 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
|
|||
buffer)
|
||||
(when (and (stringp match) (not (string-match "\\S-" match)))
|
||||
(setq match nil))
|
||||
(setq matcher (org-make-tags-matcher match)
|
||||
match (car matcher) matcher (cdr matcher))
|
||||
(catch 'exit
|
||||
(if org-agenda-sticky
|
||||
(setq org-agenda-buffer-name
|
||||
|
|
@ -4762,7 +4760,11 @@ The prefix arg TODO-ONLY limits the search to TODO entries."
|
|||
(format "*Org Agenda(%s:%s)*"
|
||||
(or org-keys (or (and todo-only "M") "m")) match)
|
||||
(format "*Org Agenda(%s)*" (or (and todo-only "M") "m")))))
|
||||
;; Prepare agendas (and `org-tag-alist-for-agenda') before
|
||||
;; expanding tags within `org-make-tags-matcher'
|
||||
(org-agenda-prepare (concat "TAGS " match))
|
||||
(setq matcher (org-make-tags-matcher match)
|
||||
match (car matcher) matcher (cdr matcher))
|
||||
(org-compile-prefix-format 'tags)
|
||||
(org-set-sorting-strategy 'tags)
|
||||
(setq org-agenda-query-string match)
|
||||
|
|
@ -7373,7 +7375,7 @@ to switch to narrowing."
|
|||
((equal char ?\r)
|
||||
(org-agenda-filter-show-all-tag)
|
||||
(when org-agenda-auto-exclude-function
|
||||
(setq org-agenda-tag-filter '())
|
||||
(setq org-agenda-tag-filter nil)
|
||||
(dolist (tag (org-agenda-get-represented-tags))
|
||||
(let ((modifier (funcall org-agenda-auto-exclude-function tag)))
|
||||
(if modifier
|
||||
|
|
@ -7430,37 +7432,59 @@ to switch to narrowing."
|
|||
(interactive "P")
|
||||
(org-agenda-filter-by-tag strip char 'refine))
|
||||
|
||||
(defun org-agenda-filter-make-matcher ()
|
||||
(defun org-agenda-filter-make-matcher (filter type)
|
||||
"Create the form that tests a line for agenda filter."
|
||||
(let (f f1)
|
||||
;; first compute the tag-filter matcher
|
||||
(dolist (x (delete-dups
|
||||
(append (get 'org-agenda-tag-filter
|
||||
:preset-filter) org-agenda-tag-filter)))
|
||||
(if (member x '("-" "+"))
|
||||
(setq f1 (if (equal x "-") 'tags '(not tags)))
|
||||
(if (string-match "[<=>?]" x)
|
||||
(setq f1 (org-agenda-filter-effort-form x))
|
||||
(setq f1 (list 'member (downcase (substring x 1)) 'tags)))
|
||||
(if (equal (string-to-char x) ?-)
|
||||
(setq f1 (list 'not f1))))
|
||||
(push f1 f))
|
||||
;; then compute the category-filter matcher
|
||||
(dolist (x (delete-dups
|
||||
(append (get 'org-agenda-category-filter
|
||||
:preset-filter) org-agenda-category-filter)))
|
||||
(if (equal "-" (substring x 0 1))
|
||||
(setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
|
||||
(setq f1 (list 'equal (substring x 1) 'cat)))
|
||||
(push f1 f))
|
||||
;; Finally compute the regexp filter
|
||||
(dolist (x (delete-dups
|
||||
(append (get 'org-agenda-regexp-filter
|
||||
:preset-filter) org-agenda-regexp-filter)))
|
||||
(if (equal "-" (substring x 0 1))
|
||||
(setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
|
||||
(setq f1 (list 'string-match (substring x 1) 'txt)))
|
||||
(push f1 f))
|
||||
(cond
|
||||
;; Tag filter
|
||||
((eq type 'tag)
|
||||
(setq filter
|
||||
(delete-dups
|
||||
(append (get 'org-agenda-tag-filter :preset-filter)
|
||||
filter)))
|
||||
(dolist (x filter)
|
||||
(let ((nfilter (org-agenda-filter-expand-tags filter)) nf nf1
|
||||
(ffunc
|
||||
(lambda (nf0 nf01 fltr notgroup op)
|
||||
(dolist (x fltr)
|
||||
(if (member x '("-" "+"))
|
||||
(setq nf01 (if (equal x "-") 'tags '(not tags)))
|
||||
(if (string-match "[<=>?]" x)
|
||||
(setq nf01 (org-agenda-filter-effort-form x))
|
||||
(setq nf01 (list 'member (downcase (substring x 1))
|
||||
'tags)))
|
||||
(when (equal (string-to-char x) ?-)
|
||||
(setq nf01 (list 'not nf01))
|
||||
(when (not notgroup) (setq op 'and))))
|
||||
(push nf01 nf0))
|
||||
(if notgroup
|
||||
(push (cons 'and nf0) f)
|
||||
(push (cons (or op 'or) nf0) f)))))
|
||||
(if (equal nfilter filter)
|
||||
(funcall ffunc f1 f filter t nil)
|
||||
(funcall ffunc nf1 nf nfilter nil nil)))))
|
||||
;; Category filter
|
||||
((eq type 'category)
|
||||
(setq filter
|
||||
(delete-dups
|
||||
(append (get 'org-agenda-category-filter :preset-filter)
|
||||
filter)))
|
||||
(dolist (x filter)
|
||||
(if (equal "-" (substring x 0 1))
|
||||
(setq f1 (list 'not (list 'equal (substring x 1) 'cat)))
|
||||
(setq f1 (list 'equal (substring x 1) 'cat)))
|
||||
(push f1 f)))
|
||||
;; Regexp filter
|
||||
((eq type 'regexp)
|
||||
(setq filter
|
||||
(delete-dups
|
||||
(append (get 'org-agenda-regexp-filter :preset-filter)
|
||||
filter)))
|
||||
(dolist (x filter)
|
||||
(if (equal "-" (substring x 0 1))
|
||||
(setq f1 (list 'not (list 'string-match (substring x 1) 'txt)))
|
||||
(setq f1 (list 'string-match (substring x 1) 'txt)))
|
||||
(push f1 f))))
|
||||
(cons 'and (nreverse f))))
|
||||
|
||||
(defun org-agenda-filter-effort-form (e)
|
||||
|
|
@ -7485,12 +7509,31 @@ If the line does not have an effort defined, return nil."
|
|||
(funcall op (or eff (if org-sort-agenda-noeffort-is-high 32767 0))
|
||||
value))))
|
||||
|
||||
(defun org-agenda-filter-expand-tags (filter &optional no-operator)
|
||||
"Expand group tags in FILTER for the agenda.
|
||||
When NO-OPERATOR is non-nil, do not add the + operator to returned tags."
|
||||
(if org-group-tags
|
||||
(let ((case-fold-search t) rtn)
|
||||
(mapc
|
||||
(lambda (f)
|
||||
(let (f0 dir)
|
||||
(if (string-match "^\\([+-]\\)\\(.+\\)" f)
|
||||
(setq dir (match-string 1 f) f0 (match-string 2 f))
|
||||
(setq dir (if no-operator "" "+") f0 f))
|
||||
(setq rtn (append (mapcar (lambda(f1) (concat dir f1))
|
||||
(org-tags-expand f0 t t))
|
||||
rtn))))
|
||||
filter)
|
||||
(reverse rtn))
|
||||
filter))
|
||||
|
||||
(defun org-agenda-filter-apply (filter type)
|
||||
"Set FILTER as the new agenda filter and apply it."
|
||||
;; Deactivate `org-agenda-entry-text-mode' when filtering
|
||||
(if org-agenda-entry-text-mode (org-agenda-entry-text-mode))
|
||||
(let (tags cat txt)
|
||||
(setq org-agenda-filter-form (org-agenda-filter-make-matcher))
|
||||
(setq org-agenda-filter-form
|
||||
(org-agenda-filter-make-matcher filter type))
|
||||
(if (and (eq type 'category)
|
||||
(not (equal (substring (car filter) 0 1) "-")))
|
||||
;; Only set `org-agenda-filtered-by-category' to t
|
||||
|
|
@ -7502,7 +7545,11 @@ If the line does not have an effort defined, return nil."
|
|||
(while (not (eobp))
|
||||
(if (org-get-at-bol 'org-marker)
|
||||
(progn
|
||||
(setq tags (org-get-at-bol 'tags) ; used in eval
|
||||
(setq tags ; used in eval
|
||||
(apply 'append
|
||||
(mapcar (lambda (f)
|
||||
(org-agenda-filter-expand-tags (list f) t))
|
||||
(org-get-at-bol 'tags)))
|
||||
cat (get-text-property (point) 'org-category)
|
||||
txt (get-text-property (point) 'txt))
|
||||
(if (not (eval org-agenda-filter-form))
|
||||
|
|
|
|||
|
|
@ -790,6 +790,13 @@ level org-n-level-faces"
|
|||
:version "24.4"
|
||||
:package-version '(Org . "8.0"))
|
||||
|
||||
(defface org-tag-group
|
||||
(org-compatible-face 'org-tag nil)
|
||||
"Face for group tags."
|
||||
:group 'org-faces
|
||||
:version "24.4"
|
||||
:package-version '(Org . "8.0"))
|
||||
|
||||
(org-copy-face 'mode-line 'org-mode-line-clock
|
||||
"Face used for clock display in mode line.")
|
||||
(org-copy-face 'mode-line 'org-mode-line-clock-overrun
|
||||
|
|
|
|||
|
|
@ -239,6 +239,7 @@ When completing for #+STARTUP, for example, this function returns
|
|||
(cond
|
||||
((eq :startgroup (car x)) "{")
|
||||
((eq :endgroup (car x)) "}")
|
||||
((eq :grouptags (car x)) ":")
|
||||
((eq :newline (car x)) "\\n")
|
||||
((cdr x) (format "%s(%c)" (car x) (cdr x)))
|
||||
(t (car x))))
|
||||
|
|
|
|||
276
lisp/org.el
276
lisp/org.el
|
|
@ -126,10 +126,12 @@ Stars are put in group 1 and the trimmed body in group 2.")
|
|||
(declare-function org-beamer-mode "ox-beamer" ())
|
||||
(declare-function org-table-edit-field "org-table" (arg))
|
||||
(declare-function org-table-justify-field-maybe "org-table" (&optional new))
|
||||
(declare-function org-table-set-constants "org-table" ())
|
||||
(declare-function org-id-get-create "org-id" (&optional force))
|
||||
(declare-function org-id-find-id-file "org-id" (id))
|
||||
(declare-function org-tags-view "org-agenda" (&optional todo-only match))
|
||||
(declare-function org-agenda-list "org-agenda" (&optional arg start-day span))
|
||||
(declare-function org-agenda-redo "org-agenda" (&optional all))
|
||||
(declare-function org-table-align "org-table" ())
|
||||
(declare-function org-table-paste-rectangle "org-table" ())
|
||||
(declare-function org-table-maybe-eval-formula "org-table" ())
|
||||
|
|
@ -1324,9 +1326,9 @@ and a boolean flag as CDR. The cdr may also be the symbol `auto', in
|
|||
which case Org will look at the surrounding headings/items and try to
|
||||
make an intelligent decision whether to insert a blank line or not.
|
||||
|
||||
For plain lists, if the variable `org-empty-line-terminates-plain-lists' is
|
||||
set, the setting here is ignored and no empty line is inserted, to avoid
|
||||
breaking the list structure."
|
||||
For plain lists, if `org-list-empty-line-terminates-plain-lists' is set,
|
||||
the setting here is ignored and no empty line is inserted to avoid breaking
|
||||
the list structure."
|
||||
:group 'org-edit-structure
|
||||
:type '(list
|
||||
(cons (const heading)
|
||||
|
|
@ -2288,7 +2290,12 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'."
|
|||
(defvar org-done-keywords-for-agenda nil)
|
||||
(defvar org-drawers-for-agenda nil)
|
||||
(defvar org-todo-keyword-alist-for-agenda nil)
|
||||
(defvar org-tag-alist-for-agenda nil)
|
||||
(defvar org-tag-alist-for-agenda nil
|
||||
"Alist of all tags from all agenda files.")
|
||||
(defvar org-tag-groups-alist-for-agenda nil
|
||||
"Alist of all groups tags from all current agenda files.")
|
||||
(defvar org-tag-groups-alist nil)
|
||||
(make-variable-buffer-local 'org-tag-groups-alist)
|
||||
(defvar org-agenda-contributing-files nil)
|
||||
(defvar org-not-done-keywords nil)
|
||||
(make-variable-buffer-local 'org-not-done-keywords)
|
||||
|
|
@ -3170,6 +3177,8 @@ See the manual for details."
|
|||
(list :tag "Start radio group"
|
||||
(const :startgroup)
|
||||
(option (string :tag "Group description")))
|
||||
(list :tag "Group tags delimiter"
|
||||
(const :grouptags))
|
||||
(list :tag "End radio group"
|
||||
(const :endgroup)
|
||||
(option (string :tag "Group description")))
|
||||
|
|
@ -3192,6 +3201,7 @@ To disable these tags on a per-file basis, insert anywhere in the file:
|
|||
(cons (string :tag "Tag name")
|
||||
(character :tag "Access char"))
|
||||
(const :tag "Start radio group" (:startgroup))
|
||||
(const :tag "Group tags delimiter" (:grouptags))
|
||||
(const :tag "End radio group" (:endgroup))
|
||||
(const :tag "New line" (:newline)))))
|
||||
|
||||
|
|
@ -4730,8 +4740,97 @@ This regexp can match any headline with the specified keyword, or
|
|||
without a keyword. The keyword isn't in any group by default,
|
||||
but the stars and the body are.")
|
||||
|
||||
(defcustom org-group-tags t
|
||||
"When non-nil (the default), use group tags.
|
||||
This can be turned on/off through `org-toggle-tags-groups'."
|
||||
:group 'org-tags
|
||||
:group 'org-startup
|
||||
:type 'boolean)
|
||||
|
||||
(defun org-toggle-tags-groups ()
|
||||
"Toggle support for group tags.
|
||||
Support for group tags is controlled by the option
|
||||
`org-group-tags', which is non-nil by default."
|
||||
(interactive)
|
||||
(setq org-group-tags (not org-group-tags))
|
||||
(if (and (derived-mode-p 'org-agenda-mode)
|
||||
org-group-tags)
|
||||
(org-agenda-redo))
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-set-regexps-and-options-for-tags)
|
||||
(org-set-regexps-and-options))
|
||||
(message "Groups tags support has been turned %s"
|
||||
(if org-group-tags "on" "off")))
|
||||
|
||||
(defun org-set-regexps-and-options-for-tags ()
|
||||
"Precompute regular expressions used for tags in the current buffer."
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-set-local 'org-file-tags nil)
|
||||
(let ((re (org-make-options-regexp '("FILETAGS" "TAGS")))
|
||||
(splitre "[ \t]+")
|
||||
tags ftags key value
|
||||
(start 0))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(widen)
|
||||
(goto-char (point-min))
|
||||
(while (re-search-forward re nil t)
|
||||
(setq key (upcase (org-match-string-no-properties 1))
|
||||
value (org-match-string-no-properties 2))
|
||||
(if (stringp value) (setq value (org-trim value)))
|
||||
(cond
|
||||
((equal key "TAGS")
|
||||
(setq tags (append tags (if tags '("\\n") nil)
|
||||
(org-split-string value splitre))))
|
||||
((equal key "FILETAGS")
|
||||
(when (string-match "\\S-" value)
|
||||
(setq ftags
|
||||
(append
|
||||
ftags
|
||||
(apply 'append
|
||||
(mapcar (lambda (x) (org-split-string x ":"))
|
||||
(org-split-string value)))))))))))
|
||||
;; Process the file tags.
|
||||
(and ftags (org-set-local 'org-file-tags
|
||||
(mapcar 'org-add-prop-inherited ftags)))
|
||||
(org-set-local 'org-tag-groups-alist nil)
|
||||
;; Process the tags.
|
||||
;; FIXME
|
||||
(when tags
|
||||
(let (e tgs g)
|
||||
(while (setq e (pop tags))
|
||||
(cond
|
||||
((equal e "{")
|
||||
(progn (push '(:startgroup) tgs)
|
||||
(when (equal (nth 1 tags) ":")
|
||||
(push (list (replace-regexp-in-string
|
||||
"(.+)$" "" (nth 0 tags)))
|
||||
org-tag-groups-alist)
|
||||
(setq g 0))))
|
||||
((equal e ":") (push '(:grouptags) tgs))
|
||||
((equal e "}") (push '(:endgroup) tgs) (if g (setq g nil)))
|
||||
((equal e "\\n") (push '(:newline) tgs))
|
||||
((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
|
||||
(push (cons (match-string 1 e)
|
||||
(string-to-char (match-string 2 e))) tgs)
|
||||
(if (and g (> g 0))
|
||||
(setcar org-tag-groups-alist
|
||||
(append (car org-tag-groups-alist)
|
||||
(list (match-string 1 e)))))
|
||||
(if g (setq g (1+ g))))
|
||||
(t (push (list e) tgs)
|
||||
(if (and g (> g 0))
|
||||
(setcar org-tag-groups-alist
|
||||
(append (car org-tag-groups-alist) (list e))))
|
||||
(if g (setq g (1+ g))))))
|
||||
(org-set-local 'org-tag-alist nil)
|
||||
(while (setq e (pop tgs))
|
||||
(or (and (stringp (car e))
|
||||
(assoc (car e) org-tag-alist))
|
||||
(push e org-tag-alist))))))))
|
||||
|
||||
(defun org-set-regexps-and-options ()
|
||||
"Precompute regular expressions for current buffer."
|
||||
"Precompute regular expressions used in the current buffer."
|
||||
(when (derived-mode-p 'org-mode)
|
||||
(org-set-local 'org-todo-kwd-alist nil)
|
||||
(org-set-local 'org-todo-key-alist nil)
|
||||
|
|
@ -4742,16 +4841,15 @@ but the stars and the body are.")
|
|||
(org-set-local 'org-todo-sets nil)
|
||||
(org-set-local 'org-todo-log-states nil)
|
||||
(org-set-local 'org-file-properties nil)
|
||||
(org-set-local 'org-file-tags nil)
|
||||
(let ((re (org-make-options-regexp
|
||||
'("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE" "FILETAGS"
|
||||
"TAGS" "LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS"
|
||||
'("CATEGORY" "TODO" "COLUMNS" "STARTUP" "ARCHIVE"
|
||||
"LINK" "PRIORITIES" "CONSTANTS" "PROPERTY" "DRAWERS"
|
||||
"SETUPFILE" "OPTIONS")
|
||||
"\\(?:[a-zA-Z][0-9a-zA-Z_]*_TODO\\)"))
|
||||
(splitre "[ \t]+")
|
||||
(scripts org-use-sub-superscripts)
|
||||
kwds kws0 kwsa key log value cat arch tags const links hw dws
|
||||
tail sep kws1 prio props ftags drawers ext-setup-or-nil setup-contents
|
||||
kwds kws0 kwsa key log value cat arch const links hw dws
|
||||
tail sep kws1 prio props drawers ext-setup-or-nil setup-contents
|
||||
(start 0))
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
|
|
@ -4776,9 +4874,6 @@ but the stars and the body are.")
|
|||
;; general TODO-like setup
|
||||
(push (cons (intern (downcase (match-string 1 key)))
|
||||
(org-split-string value splitre)) kwds))
|
||||
((equal key "TAGS")
|
||||
(setq tags (append tags (if tags '("\\n") nil)
|
||||
(org-split-string value splitre))))
|
||||
((equal key "COLUMNS")
|
||||
(org-set-local 'org-columns-default-format value))
|
||||
((equal key "LINK")
|
||||
|
|
@ -4793,14 +4888,6 @@ but the stars and the body are.")
|
|||
(setq props (org-update-property-plist (match-string 1 value)
|
||||
(match-string 2 value)
|
||||
props))))
|
||||
((equal key "FILETAGS")
|
||||
(when (string-match "\\S-" value)
|
||||
(setq ftags
|
||||
(append
|
||||
ftags
|
||||
(apply 'append
|
||||
(mapcar (lambda (x) (org-split-string x ":"))
|
||||
(org-split-string value)))))))
|
||||
((equal key "DRAWERS")
|
||||
(setq drawers (delete-dups (append org-drawers (org-split-string value splitre)))))
|
||||
((equal key "CONSTANTS")
|
||||
|
|
@ -4856,8 +4943,6 @@ but the stars and the body are.")
|
|||
(org-set-local 'org-lowest-priority (nth 1 prio))
|
||||
(org-set-local 'org-default-priority (nth 2 prio)))
|
||||
(and props (org-set-local 'org-file-properties (nreverse props)))
|
||||
(and ftags (org-set-local 'org-file-tags
|
||||
(mapcar 'org-add-prop-inherited ftags)))
|
||||
(and drawers (org-set-local 'org-drawers drawers))
|
||||
(and arch (org-set-local 'org-archive-location arch))
|
||||
(and links (setq org-link-abbrev-alist-local (nreverse links)))
|
||||
|
|
@ -4908,26 +4993,6 @@ but the stars and the body are.")
|
|||
org-todo-kwd-alist (nreverse org-todo-kwd-alist)
|
||||
org-todo-key-trigger (delq nil (mapcar 'cdr org-todo-key-alist))
|
||||
org-todo-key-alist (org-assign-fast-keys org-todo-key-alist)))
|
||||
|
||||
;; Process the tags.
|
||||
(when tags
|
||||
(let (e tgs)
|
||||
(while (setq e (pop tags))
|
||||
(cond
|
||||
((equal e "{") (push '(:startgroup) tgs))
|
||||
((equal e "}") (push '(:endgroup) tgs))
|
||||
((equal e "\\n") (push '(:newline) tgs))
|
||||
((string-match (org-re "^\\([[:alnum:]_@#%]+\\)(\\(.\\))$") e)
|
||||
(push (cons (match-string 1 e)
|
||||
(string-to-char (match-string 2 e)))
|
||||
tgs))
|
||||
(t (push (list e) tgs))))
|
||||
(org-set-local 'org-tag-alist nil)
|
||||
(while (setq e (pop tgs))
|
||||
(or (and (stringp (car e))
|
||||
(assoc (car e) org-tag-alist))
|
||||
(push e org-tag-alist)))))
|
||||
|
||||
;; Compute the regular expressions and other local variables.
|
||||
;; Using `org-outline-regexp-bol' would complicate them much,
|
||||
;; because of the fixed white space at the end of that string.
|
||||
|
|
@ -5064,7 +5129,7 @@ This will extract info from a string like \"WAIT(w@/!)\"."
|
|||
Respect keys that are already there."
|
||||
(let (new e (alt ?0))
|
||||
(while (setq e (pop alist))
|
||||
(if (or (memq (car e) '(:newline :endgroup :startgroup))
|
||||
(if (or (memq (car e) '(:newline :grouptags :endgroup :startgroup))
|
||||
(cdr e)) ;; Key already assigned.
|
||||
(push e new)
|
||||
(let ((clist (string-to-list (downcase (car e))))
|
||||
|
|
@ -5208,6 +5273,7 @@ The following commands are available:
|
|||
org-ellipsis)))
|
||||
(if (stringp org-ellipsis) org-ellipsis "..."))))
|
||||
(setq buffer-display-table org-display-table))
|
||||
(org-set-regexps-and-options-for-tags)
|
||||
(org-set-regexps-and-options)
|
||||
(when (and org-tag-faces (not org-tags-special-faces-re))
|
||||
;; tag faces set outside customize.... force initialization.
|
||||
|
|
@ -5672,7 +5738,7 @@ by a #."
|
|||
(error (message "org-mode fontification error"))))
|
||||
|
||||
(defun org-fontify-meta-lines-and-blocks-1 (limit)
|
||||
"Fontify #+ lines and blocks, in the correct ways."
|
||||
"Fontify #+ lines and blocks."
|
||||
(let ((case-fold-search t))
|
||||
(if (re-search-forward
|
||||
"^\\([ \t]*#\\(\\(\\+[a-zA-Z]+:?\\| \\|$\\)\\(_\\([a-zA-Z]+\\)\\)?\\)[ \t]*\\(\\([^ \t\n]*\\)[ \t]*\\(.*\\)\\)\\)"
|
||||
|
|
@ -6088,6 +6154,12 @@ needs to be inserted at a specific position in the font-lock sequence.")
|
|||
'(org-font-lock-add-priority-faces)
|
||||
;; Tags
|
||||
'(org-font-lock-add-tag-faces)
|
||||
;; Tags groups
|
||||
(if (and org-group-tags org-tag-groups-alist)
|
||||
(list (concat org-outline-regexp-bol ".+\\(:"
|
||||
(regexp-opt (mapcar 'car org-tag-groups-alist))
|
||||
":\\).*$")
|
||||
'(1 'org-tag-group prepend)))
|
||||
;; Special keywords
|
||||
(list (concat "\\<" org-deadline-string) '(0 'org-special-keyword t))
|
||||
(list (concat "\\<" org-scheduled-string) '(0 'org-special-keyword t))
|
||||
|
|
@ -12017,8 +12089,7 @@ For calling through lisp, arg is also interpreted in the following way:
|
|||
(not org-todo-key-trigger)))
|
||||
;; Read a state with completion
|
||||
(org-icompleting-read
|
||||
"State: " (mapcar (lambda(x) (list x))
|
||||
org-todo-keywords-1)
|
||||
"State: " (mapcar 'list org-todo-keywords-1)
|
||||
nil t))
|
||||
((eq arg 'right)
|
||||
(if this
|
||||
|
|
@ -13828,7 +13899,7 @@ See also `org-scan-tags'.
|
|||
"
|
||||
(declare (special todo-only))
|
||||
(unless (boundp 'todo-only)
|
||||
(error "org-make-tags-matcher expects todo-only to be scoped in"))
|
||||
(error "`org-make-tags-matcher' expects todo-only to be scoped in"))
|
||||
(unless match
|
||||
;; Get a new match request, with completion
|
||||
(let ((org-last-tags-completion-table
|
||||
|
|
@ -13844,6 +13915,8 @@ See also `org-scan-tags'.
|
|||
tagsmatch todomatch tagsmatcher todomatcher kwd matcher
|
||||
orterms term orlist re-p str-p level-p level-op time-p
|
||||
prop-p pn pv po gv rest)
|
||||
;; Expand group tags
|
||||
(setq match (org-tags-expand match))
|
||||
(if (string-match "/+" match)
|
||||
;; match contains also a todo-matching request
|
||||
(progn
|
||||
|
|
@ -13950,6 +14023,54 @@ See also `org-scan-tags'.
|
|||
matcher)))
|
||||
(cons match0 matcher)))
|
||||
|
||||
(defun org-tags-expand (match &optional single-as-list downcased)
|
||||
"Expand group tags in MATCH.
|
||||
|
||||
This replaces every group tag in MATCH with a regexp tag search.
|
||||
For example, a group tag \"Work\" defined as { Work : Lab Conf }
|
||||
will be replaced like this:
|
||||
|
||||
Work => {\(?:Work\|Lab\|Conf\}
|
||||
+Work => +{\(?:Work\|Lab\|Conf\}
|
||||
-Work => -{\(?:Work\|Lab\|Conf\}
|
||||
|
||||
Replacing by a regexp preserves the structure of the match.
|
||||
E.g., this expansion
|
||||
|
||||
Work|Home => {\(?:Work\|Lab\|Conf\}|Home
|
||||
|
||||
will match anything tagged with \"Lab\" and \"Home\", or tagged
|
||||
with \"Conf\" and \"Home\" or tagged with \"Work\" and \"home\".
|
||||
|
||||
When the optional argument SINGLE-AS-LIST is non-nil, MATCH is
|
||||
assumed to be a single group tag, and the function will return
|
||||
the list of tags in this group.
|
||||
|
||||
When DOWNCASE is non-nil, expand downcased TAGS."
|
||||
(if org-group-tags
|
||||
(let* ((case-fold-search t)
|
||||
(tal (or org-tag-groups-alist-for-agenda
|
||||
org-tag-groups-alist))
|
||||
(tal (if downcased (mapcar (lambda(tg) (mapcar 'downcase tg)) tal) tal))
|
||||
(tml (mapcar 'car tal))
|
||||
(rtnmatch match) rpl)
|
||||
(while (and tml (string-match
|
||||
(concat "\\(?1:[+-]?\\)\\(?2:" (regexp-opt tml) "\\)")
|
||||
rtnmatch))
|
||||
(let* ((dir (match-string 1 rtnmatch))
|
||||
(tag (match-string 2 rtnmatch))
|
||||
(tag (if downcased (downcase tag) tag)))
|
||||
(setq tml (delete tag tml))
|
||||
(setq rpl (append (org-uniquify rpl) (assoc tag tal)))
|
||||
(setq rtnmatch
|
||||
(replace-match
|
||||
(concat dir "{" (regexp-opt rpl) "}") t t rtnmatch))))
|
||||
(if single-as-list
|
||||
(or (reverse rpl) (list rtnmatch))
|
||||
rtnmatch))
|
||||
(if single-as-list (list (if downcased (downcase match) match))
|
||||
match)))
|
||||
|
||||
(defun org-op-to-function (op &optional stringp)
|
||||
"Turn an operator into the appropriate function."
|
||||
(setq op
|
||||
|
|
@ -14346,15 +14467,14 @@ This works in the agenda, and also in an org-mode buffer."
|
|||
rtn)
|
||||
((eq flag t)
|
||||
;; all-completions
|
||||
(all-completions s2 ctable confirm)
|
||||
)
|
||||
(all-completions s2 ctable confirm))
|
||||
((eq flag 'lambda)
|
||||
;; exact match?
|
||||
(assoc s2 ctable)))
|
||||
))
|
||||
(assoc s2 ctable)))))
|
||||
|
||||
(defun org-fast-tag-insert (kwd tags face &optional end)
|
||||
"Insert KDW, and the TAGS, the latter with face FACE. Also insert END."
|
||||
"Insert KDW, and the TAGS, the latter with face FACE.
|
||||
Also insert END."
|
||||
(insert (format "%-12s" (concat kwd ":"))
|
||||
(org-add-props (mapconcat 'identity tags " ") nil 'face face)
|
||||
(or end "")))
|
||||
|
|
@ -14370,6 +14490,7 @@ This works in the agenda, and also in an org-mode buffer."
|
|||
(insert (org-add-props " Next change exits" nil 'face 'org-warning)))))
|
||||
|
||||
(defun org-set-current-tags-overlay (current prefix)
|
||||
"Add an overlay to CURRENT tag with PREFIX."
|
||||
(let ((s (concat ":" (mapconcat 'identity current ":") ":")))
|
||||
(if (featurep 'xemacs)
|
||||
(org-overlay-display org-tags-overlay (concat prefix s)
|
||||
|
|
@ -14452,6 +14573,7 @@ Returns the new tags string, or nil to not change the current settings."
|
|||
(while (equal (car tbl) '(:newline))
|
||||
(insert "\n")
|
||||
(setq tbl (cdr tbl)))))
|
||||
((equal e '(:grouptags)) nil)
|
||||
(t
|
||||
(setq tg (copy-sequence (car e)) c2 nil)
|
||||
(if (cdr e)
|
||||
|
|
@ -14467,11 +14589,13 @@ Returns the new tags string, or nil to not change the current settings."
|
|||
(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))
|
||||
((member tg current) c-face)
|
||||
((member tg inherited) i-face))))
|
||||
(cond
|
||||
((not (assoc tg table))
|
||||
(org-get-todo-face tg))
|
||||
((member tg current) c-face)
|
||||
((member tg inherited) i-face))))
|
||||
(if (equal (caar tbl) :grouptags)
|
||||
(org-add-props tg nil 'face 'org-tag-group))
|
||||
(if (and (= cnt 0) (not ingroup)) (insert " "))
|
||||
(insert "[" c "] " tg (make-string
|
||||
(- fwidth 4 (length tg)) ?\ ))
|
||||
|
|
@ -17120,7 +17244,7 @@ When SUPPRESS-TMP-DELAY is non-nil, suppress delays like \"--2d\"."
|
|||
;; Maybe adjust the closest clock in `org-clock-history'
|
||||
(when org-clock-adjust-closest
|
||||
(if (not (and (org-at-clock-log-p)
|
||||
(< 1 (length (delq nil (mapcar (lambda(m) (marker-position m))
|
||||
(< 1 (length (delq nil (mapcar 'marker-position
|
||||
org-clock-history))))))
|
||||
(message "No clock to adjust")
|
||||
(cond ((save-excursion ; fix previous clock?
|
||||
|
|
@ -17747,7 +17871,9 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
|
|||
(inhibit-read-only t)
|
||||
(org-inhibit-startup org-agenda-inhibit-startup)
|
||||
(rea (concat ":" org-archive-tag ":"))
|
||||
file re)
|
||||
file re org-tag-alist)
|
||||
(setq org-tag-alist-for-agenda nil
|
||||
org-tag-groups-alist-for-agenda nil)
|
||||
(save-excursion
|
||||
(save-restriction
|
||||
(while (setq file (pop files))
|
||||
|
|
@ -17757,6 +17883,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
|
|||
(org-check-agenda-file file)
|
||||
(set-buffer (org-get-agenda-file-buffer file)))
|
||||
(widen)
|
||||
(org-set-regexps-and-options-for-tags)
|
||||
(org-refresh-category-properties)
|
||||
(org-refresh-properties org-effort-property 'org-effort)
|
||||
(org-refresh-properties "APPT_WARNTIME" 'org-appt-warntime)
|
||||
|
|
@ -17770,6 +17897,10 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
|
|||
(append org-drawers-for-agenda org-drawers))
|
||||
(setq org-tag-alist-for-agenda
|
||||
(append org-tag-alist-for-agenda org-tag-alist))
|
||||
(if org-group-tags
|
||||
(setq org-tag-groups-alist-for-agenda
|
||||
(org-uniquify-alist
|
||||
(append org-tag-groups-alist-for-agenda org-tag-groups-alist))))
|
||||
(org-with-silent-modifications
|
||||
(save-excursion
|
||||
(remove-text-properties (point-min) (point-max) pall)
|
||||
|
|
@ -17787,8 +17918,7 @@ When a buffer is unmodified, it is just killed. When modified, it is saved
|
|||
(setq org-todo-keywords-for-agenda
|
||||
(org-uniquify org-todo-keywords-for-agenda))
|
||||
(setq org-todo-keyword-alist-for-agenda
|
||||
(org-uniquify org-todo-keyword-alist-for-agenda)
|
||||
org-tag-alist-for-agenda (org-uniquify org-tag-alist-for-agenda))))
|
||||
(org-uniquify org-todo-keyword-alist-for-agenda))))
|
||||
|
||||
|
||||
;;;; CDLaTeX minor mode
|
||||
|
|
@ -18735,6 +18865,7 @@ BEG and END default to the buffer boundaries."
|
|||
(org-defkey org-mode-map "\C-c\C-xa" 'org-toggle-archive-tag)
|
||||
(org-defkey org-mode-map "\C-c\C-xA" 'org-archive-to-archive-sibling)
|
||||
(org-defkey org-mode-map "\C-c\C-xb" 'org-tree-to-indirect-buffer)
|
||||
(org-defkey org-mode-map "\C-c\C-xq" 'org-toggle-tags-groups)
|
||||
(org-defkey org-mode-map "\C-c\C-j" 'org-goto)
|
||||
(org-defkey org-mode-map "\C-c\C-t" 'org-todo)
|
||||
(org-defkey org-mode-map "\C-c\C-q" 'org-set-tags-command)
|
||||
|
|
@ -21382,6 +21513,27 @@ for the search purpose."
|
|||
(mapc (lambda (x) (add-to-list 'res x 'append)) list)
|
||||
res))
|
||||
|
||||
(defun org-uniquify-alist (alist)
|
||||
"Merge duplicate elements of an alist.
|
||||
|
||||
For example, in this alist:
|
||||
|
||||
\(org-uniquify-alist '((a 1) (b 2) (a 3)))
|
||||
=> '((a 1 3) (b 2))
|
||||
|
||||
merge (a 1) and (a 3) into (a 1 3) and return the new alist."
|
||||
(let (rtn)
|
||||
(mapc
|
||||
(lambda (e)
|
||||
(let (n)
|
||||
(if (not (assoc (car e) rtn))
|
||||
(push e rtn)
|
||||
(setq n (cons (car e) (append (cdr (assoc (car e) rtn)) (cdr e))))
|
||||
(setq rtn (assq-delete-all (car e) rtn))
|
||||
(push n rtn))))
|
||||
alist)
|
||||
rtn))
|
||||
|
||||
(defun org-delete-all (elts list)
|
||||
"Remove all elements in ELTS from LIST."
|
||||
(while elts
|
||||
|
|
|
|||
Loading…
Reference in New Issue