Browse Source

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.
Bastien Guerry 6 years ago
parent
commit
a9880a7710
4 changed files with 303 additions and 96 deletions
  1. 81 34
      lisp/org-agenda.el
  2. 7 0
      lisp/org-faces.el
  3. 1 0
      lisp/org-pcomplete.el
  4. 214 62
      lisp/org.el

+ 81 - 34
lisp/org-agenda.el

@@ -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))

+ 7 - 0
lisp/org-faces.el

@@ -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

+ 1 - 0
lisp/org-pcomplete.el

@@ -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))))

+ 214 - 62
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