From 61a241f0dc07aef5a3a5c2bd037a197236bde2e6 Mon Sep 17 00:00:00 2001 From: Nicolas Goaziou Date: Tue, 14 Oct 2014 10:53:29 +0200 Subject: [PATCH] Rewrite setup keywords initialization * lisp/org-table.el (org-table-set-constants): Remove function. * lisp/org.el (org-set-regexps-and-options): Rewrite function. Merge it with `org-set-regexps-and-options-for-tags'. (org-set-regexps-and-options-for-tags): Remove function (org--setup-collect-keywords, org--setup-process-tags): New functions. (org-mode): Remove `org-set-regexps-and-options-for-tags' call. (org-agenda-prepare-buffers): Use optimized setup for tags in all cases. Improve docstring. (org-make-options-regexp): Make returned regexp more efficient. --- lisp/org-table.el | 18 -- lisp/org.el | 610 +++++++++++++++++++++++----------------------- 2 files changed, 301 insertions(+), 327 deletions(-) diff --git a/lisp/org-table.el b/lisp/org-table.el index bdd4476f8..8f36d22b4 100644 --- a/lisp/org-table.el +++ b/lisp/org-table.el @@ -2995,24 +2995,6 @@ list, 'literal is for the format specifier L." elements ",") "]")))) -;;;###autoload -(defun org-table-set-constants () - "Set `org-table-formula-constants-local' in the current buffer." - (let (cst consts const-str) - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "^[ \t]*#\\+CONSTANTS: \\(.*\\)" nil t) - (setq const-str (substring-no-properties (match-string 1))) - (setq consts (append consts (org-split-string const-str "[ \t]+"))) - (when consts - (let (e) - (while (setq e (pop consts)) - (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" e) - (if (assoc-string (match-string 1 e) cst) - (setq cst (delete (assoc-string (match-string 1 e) cst) cst))) - (push (cons (match-string 1 e) (match-string 2 e)) cst))) - (setq org-table-formula-constants-local cst))))))) - ;;;###autoload (defun org-table-recalculate (&optional all noalign) "Recalculate the current table line by applying all stored formulas. diff --git a/lisp/org.el b/lisp/org.el index faa73e483..96829a7d5 100755 --- a/lisp/org.el +++ b/lisp/org.el @@ -4941,303 +4941,302 @@ Support for group tags is controlled by the option (message "Groups tags support has been turned %s" (if org-group-tags "on" "off"))) -(defun org-set-regexps-and-options-for-tags () - "Precompute variables used for tags." +(defun org-set-regexps-and-options (&optional tags-only) + "Precompute regular expressions used in the current buffer. +When optional argument TAGS-ONLY is non-nil, only compute tags +related expressions." (when (derived-mode-p 'org-mode) - (org-set-local 'org-file-tags nil) - (let ((re (org-make-options-regexp '("FILETAGS" "TAGS"))) - (splitre "[ \t]+") - (start 0) - tags ftags key value) - (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. - (when (and (not tags) org-tag-alist) - (setq tags - (mapcar - (lambda (tg) (cond ((eq (car tg) :startgroup) "{") - ((eq (car tg) :endgroup) "}") - ((eq (car tg) :grouptags) ":") - ((eq (car tg) :newline) "\n") - (t (concat (car tg) - (if (characterp (cdr tg)) - (format "(%s)" (char-to-string (cdr tg))) ""))))) - org-tag-alist))) - (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))) - ;; Return a list with tag variables - (list org-file-tags org-tag-alist org-tag-groups-alist))))) - -(defvar org-ota nil) -(defun org-set-regexps-and-options () - "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) - (org-set-local 'org-todo-key-trigger nil) - (org-set-local 'org-todo-keywords-1 nil) - (org-set-local 'org-done-keywords nil) - (org-set-local 'org-todo-heads nil) - (org-set-local 'org-todo-sets nil) - (org-set-local 'org-todo-log-states nil) - (org-set-local 'org-file-properties nil) - (let ((re (org-make-options-regexp - '("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 const links hw dws - tail sep kws1 prio props drawers ext-setup-or-nil setup-contents - (start 0)) - (save-excursion - (save-restriction - (widen) - (goto-char (point-min)) - (while - (or (and - ext-setup-or-nil - (not org-ota) - (let (ret) - (with-temp-buffer - (insert ext-setup-or-nil) - (let ((major-mode 'org-mode) org-ota) - (setq ret (save-match-data - (org-set-regexps-and-options-for-tags))))) - ;; Append setupfile tags to existing tags - (setq org-ota t) - (setq org-file-tags - (delq nil (append org-file-tags (nth 0 ret))) - org-tag-alist - (delq nil (append org-tag-alist (nth 1 ret))) - org-tag-groups-alist - (delq nil (append org-tag-groups-alist (nth 2 ret)))))) - (and ext-setup-or-nil - (string-match re ext-setup-or-nil start) - (setq start (match-end 0))) - (and (setq ext-setup-or-nil nil start 0) - (re-search-forward re nil t))) - (setq key (upcase (match-string 1 ext-setup-or-nil)) - value (org-match-string-no-properties 2 ext-setup-or-nil)) - (if (stringp value) (setq value (org-trim value))) - (cond - ((equal key "CATEGORY") - (setq cat value)) - ((member key '("SEQ_TODO" "TODO")) - (push (cons 'sequence (org-split-string value splitre)) kwds)) - ((equal key "TYP_TODO") - (push (cons 'type (org-split-string value splitre)) kwds)) - ((string-match "\\`\\([a-zA-Z][0-9a-zA-Z_]*\\)_TODO\\'" key) - ;; general TODO-like setup - (push (cons (intern (downcase (match-string 1 key))) - (org-split-string value splitre)) kwds)) - ((equal key "COLUMNS") - (org-set-local 'org-columns-default-format value)) - ((equal key "LINK") - (when (string-match "^\\(\\S-+\\)[ \t]+\\(.+\\)" value) - (push (cons (match-string 1 value) - (org-trim (match-string 2 value))) - links))) - ((equal key "PRIORITIES") - (setq prio (org-split-string value " +"))) - ((equal key "PROPERTY") - (when (string-match "\\(\\S-+\\)\\s-+\\(.*\\)" value) - (setq props (org--update-property-plist (match-string 1 value) - (match-string 2 value) - props)))) - ((equal key "CONSTANTS") - (org-table-set-constants)) - ((equal key "STARTUP") - (let ((opts (org-split-string value splitre)) - l var val) - (while (setq l (pop opts)) - (when (setq l (assoc l org-startup-options)) - (setq var (nth 1 l) val (nth 2 l)) - (if (not (nth 3 l)) - (set (make-local-variable var) val) - (if (not (listp (symbol-value var))) - (set (make-local-variable var) nil)) - (set (make-local-variable var) (symbol-value var)) - (add-to-list var val)))))) - ((equal key "ARCHIVE") - (setq arch value) - (remove-text-properties 0 (length arch) - '(face t fontified t) arch)) - ((equal key "OPTIONS") - (if (string-match "\\([ \t]\\|\\`\\)\\^:\\(t\\|nil\\|{}\\)" value) - (setq scripts (read (match-string 2 value))))) - ((and (equal key "SETUPFILE") - ;; Prevent checking in Gnus messages - (not buffer-read-only)) - (setq setup-contents (org-file-contents - (expand-file-name - (org-remove-double-quotes value)) - 'noerror)) - (if (not ext-setup-or-nil) - (setq ext-setup-or-nil setup-contents start 0) - (setq ext-setup-or-nil - (concat (substring ext-setup-or-nil 0 start) - "\n" setup-contents "\n" - (substring ext-setup-or-nil start))))))))) - (org-set-local 'org-use-sub-superscripts scripts) - (when cat - (org-set-local 'org-category (intern cat)) - (push (cons "CATEGORY" cat) props)) - (when prio - (if (< (length prio) 3) (setq prio '("A" "C" "B"))) - (setq prio (mapcar 'string-to-char prio)) - (org-set-local 'org-highest-priority (nth 0 prio)) - (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 props)) - (and arch (org-set-local 'org-archive-location arch)) - (and links (setq org-link-abbrev-alist-local (nreverse links))) - ;; Process the TODO keywords - (unless kwds - ;; Use the global values as if they had been given locally. - (setq kwds (default-value 'org-todo-keywords)) - (if (stringp (car kwds)) - (setq kwds (list (cons org-todo-interpretation - (default-value 'org-todo-keywords))))) - (setq kwds (reverse kwds))) - (setq kwds (nreverse kwds)) - (let (inter kws kw) - (while (setq kws (pop kwds)) - (let ((kws (or - (run-hook-with-args-until-success - 'org-todo-setup-filter-hook kws) - kws))) - (setq inter (pop kws) sep (member "|" kws) - kws0 (delete "|" (copy-sequence kws)) - kwsa nil - kws1 (mapcar - (lambda (x) - ;; 1 2 - (if (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" x) - (progn - (setq kw (match-string 1 x) - key (and (match-end 2) (match-string 2 x)) - log (org-extract-log-state-settings x)) - (push (cons kw (and key (string-to-char key))) kwsa) - (and log (push log org-todo-log-states)) - kw) - (error "Invalid TODO keyword %s" x))) - kws0) - kwsa (if kwsa (append '((:startgroup)) - (nreverse kwsa) - '((:endgroup)))) - hw (car kws1) - dws (if sep (org-remove-keyword-keys (cdr sep)) (last kws1)) - tail (list inter hw (car dws) (org-last dws)))) - (add-to-list 'org-todo-heads hw 'append) - (push kws1 org-todo-sets) - (setq org-done-keywords (append org-done-keywords dws nil)) - (setq org-todo-key-alist (append org-todo-key-alist kwsa)) - (mapc (lambda (x) (push (cons x tail) org-todo-kwd-alist)) kws1) - (setq org-todo-keywords-1 (append org-todo-keywords-1 kws1 nil))) + (let ((alist (org--setup-collect-keywords + (org-make-options-regexp + (append '("FILETAGS" "TAGS" "SETUPFILE") + (and (not tags-only) + '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS" + "LINK" "PRIORITIES" "PROPERTY" "SEQ_TODO" + "STARTUP" "TODO" "TYP_TODO"))))))) + (org--setup-process-tags + (cdr (assq 'tags alist)) (cdr (assq 'filetags alist))) + (unless tags-only + ;; File properties. + (org-set-local 'org-file-properties (cdr (assq 'property alist))) + ;; Archive location. + (let ((archive (cdr (assq 'archive alist)))) + (when archive (org-set-local 'org-archive-location archive))) + ;; Category. + (let ((cat (org-string-nw-p (cdr (assq 'category alist))))) + (when cat + (org-set-local 'org-category (intern cat)) + (org-set-local 'org-file-properties + (org--update-property-plist + "CATEGORY" cat org-file-properties)))) + ;; Columns. + (let ((column (cdr (assq 'columns alist)))) + (when column (org-set-local 'org-columns-default-format column))) + ;; Constants. + (setq org-table-formula-constants-local (cdr (assq 'constants alist))) + ;; Link abbreviations. + (let ((links (cdr (assq 'link alist)))) + (when links (setq org-link-abbrev-alist-local (nreverse links)))) + ;; Priorities. + (let ((priorities (cdr (assq 'priorities alist)))) + (when priorities + (org-set-local 'org-highest-priority (nth 0 priorities)) + (org-set-local 'org-lowest-priority (nth 1 priorities)) + (org-set-local 'org-default-priority (nth 2 priorities)))) + ;; Startup options. + (let ((startup (cdr (assq 'startup alist)))) + (dolist (option startup) + (let ((entry (assoc-string option org-startup-options t))) + (let ((var (nth 1 entry)) + (val (nth 2 entry))) + (if (not (nth 3 entry)) (org-set-local var val) + (unless (listp (symbol-value var)) + (org-set-local var nil)) + (add-to-list var val)))))) + ;; TODO keywords. + (org-set-local 'org-todo-kwd-alist nil) + (org-set-local 'org-todo-key-alist nil) + (org-set-local 'org-todo-key-trigger nil) + (org-set-local 'org-todo-keywords-1 nil) + (org-set-local 'org-done-keywords nil) + (org-set-local 'org-todo-heads nil) + (org-set-local 'org-todo-sets nil) + (org-set-local 'org-todo-log-states nil) + (let ((todo-sequences + (reverse + (or (cdr (assq 'todo alist)) + (let ((d (default-value 'org-todo-keywords))) + (if (not (stringp (car d))) d + ;; XXX: Backward compatibility code. + (list (cons org-todo-interpretation d)))))))) + (dolist (sequence todo-sequences) + (let* ((sequence (or (run-hook-with-args-until-success + 'org-todo-setup-filter-hook sequence) + sequence)) + (sequence-type (car sequence)) + (keywords (cdr sequence)) + (sep (member "|" keywords)) + names alist) + (dolist (k (remove "|" keywords)) + (unless (string-match "^\\(.*?\\)\\(?:(\\([^!@/]\\)?.*?)\\)?$" + k) + (error "Invalid TODO keyword %s" k)) + (let ((name (match-string 1 k)) + (key (match-string 2 k)) + (log (org-extract-log-state-settings k))) + (push name names) + (push (cons name (and key (string-to-char key))) alist) + (when log (push log org-todo-log-states)))) + (let* ((names (nreverse names)) + (done (if sep (org-remove-keyword-keys (cdr sep)) + (last names))) + (head (car names)) + (tail (list sequence-type head (car done) (org-last done)))) + (add-to-list 'org-todo-heads head 'append) + (push names org-todo-sets) + (setq org-done-keywords (append org-done-keywords done nil)) + (setq org-todo-keywords-1 (append org-todo-keywords-1 names nil)) + (setq org-todo-key-alist + (append org-todo-key-alist + (and alist + (append '((:startgroup)) + (nreverse alist) + '((:endgroup)))))) + (dolist (k names) (push (cons k tail) org-todo-kwd-alist)))))) (setq org-todo-sets (nreverse org-todo-sets) 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))) - ;; 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. - (if (not org-done-keywords) - (setq org-done-keywords (and org-todo-keywords-1 - (list (org-last org-todo-keywords-1))))) - (setq org-not-done-keywords - (org-delete-all org-done-keywords (copy-sequence org-todo-keywords-1)) - org-todo-regexp - (concat "\\(" - (mapconcat 'regexp-quote org-todo-keywords-1 "\\|") - "\\)") - org-not-done-regexp - (concat "\\(" - (mapconcat 'regexp-quote org-not-done-keywords "\\|") - "\\)") - org-not-done-heading-regexp - (format org-heading-keyword-regexp-format org-not-done-regexp) - org-todo-line-regexp - (format org-heading-keyword-maybe-regexp-format org-todo-regexp) - org-complex-heading-regexp - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") - "[ \t]*$") - org-complex-heading-regexp-format - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(\\[#.\\]\\)\\)?" - "\\(?: +" - ;; Stats cookies can be stuck to body. - "\\(?:\\[[0-9%%/]+\\] *\\)*" - "\\(%s\\)" - "\\(?: *\\[[0-9%%/]+\\]\\)*" - "\\)" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?") - "[ \t]*$") - org-todo-line-tags-regexp - (concat "^\\(\\*+\\)" - "\\(?: +" org-todo-regexp "\\)?" - "\\(?: +\\(.*?\\)\\)??" - (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") - "[ \t]*$")) - (setq org-ota nil) - (org-compute-latex-and-related-regexp)))) + org-todo-key-trigger (delq nil (mapcar #'cdr org-todo-key-alist)) + org-todo-key-alist (org-assign-fast-keys org-todo-key-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. + (if (not org-done-keywords) + (setq org-done-keywords + (and org-todo-keywords-1 (last org-todo-keywords-1)))) + (setq org-not-done-keywords + (org-delete-all org-done-keywords + (copy-sequence org-todo-keywords-1)) + org-todo-regexp (regexp-opt org-todo-keywords-1 t) + org-not-done-regexp (regexp-opt org-not-done-keywords t) + org-not-done-heading-regexp + (format org-heading-keyword-regexp-format org-not-done-regexp) + org-todo-line-regexp + (format org-heading-keyword-maybe-regexp-format org-todo-regexp) + org-complex-heading-regexp + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?: +\\(.*?\\)\\)??" + (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?") + "[ \t]*$") + org-complex-heading-regexp-format + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(\\[#.\\]\\)\\)?" + "\\(?: +" + ;; Stats cookies can be stuck to body. + "\\(?:\\[[0-9%%/]+\\] *\\)*" + "\\(%s\\)" + "\\(?: *\\[[0-9%%/]+\\]\\)*" + "\\)" + (org-re "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?") + "[ \t]*$") + org-todo-line-tags-regexp + (concat "^\\(\\*+\\)" + "\\(?: +" org-todo-regexp "\\)?" + "\\(?: +\\(.*?\\)\\)??" + (org-re "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?") + "[ \t]*$")) + (org-compute-latex-and-related-regexp))))) + +(defun org--setup-collect-keywords (regexp &optional files alist) + "Return setup keywords values as an alist. + +REGEXP matches a subset of setup keywords. FILES is a list of +file names already visited. It is used to avoid circular setup +files. ALIST, when non-nil, is the alist computed so far. + +Return value contains the following keys: `archive', `category', +`columns', `constants', `filetags', `link', `priorities', +`property', `startup', `tags' and `todo'." + (org-with-wide-buffer + (goto-char (point-min)) + (let ((case-fold-search t)) + (while (re-search-forward regexp nil t) + (let ((element (org-element-at-point))) + (when (eq (org-element-type element) 'keyword) + (let ((key (org-element-property :key element)) + (value (org-element-property :value element))) + (cond + ((equal key "ARCHIVE") + (when (org-string-nw-p value) + (push (cons 'archive value) alist))) + ((equal key "CATEGORY") (push (cons 'category value) alist)) + ((equal key "COLUMNS") (push (cons 'columns value) alist)) + ((equal key "CONSTANTS") + (let* ((constants (assq 'constants alist)) + (store (cdr constants))) + (dolist (pair (org-split-string value)) + (when (string-match "^\\([a-zA-Z0][_a-zA-Z0-9]*\\)=\\(.*\\)" + pair) + (let* ((name (match-string 1 pair)) + (value (match-string 2 pair)) + (old (assoc name store))) + (if old (setcdr old value) + (push (cons name value) store))))) + (if constants (setcdr constants store) + (push (cons 'constants store) alist)))) + ((equal key "FILETAGS") + (when (org-string-nw-p value) + (let ((old (assq 'filetags alist)) + (new (apply #'nconc + (mapcar (lambda (x) (org-split-string x ":")) + (org-split-string value))))) + (if old (setcdr old (nconc new (cdr old))) + (push (cons 'filetags new) alist))))) + ((equal key "LINK") + (when (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value) + (let ((links (assq 'link alist)) + (pair (cons (org-match-string-no-properties 1 value) + (org-match-string-no-properties 2 value)))) + (if links (push pair (cdr links)) + (push (list 'link pair) alist))))) + ((equal key "PRIORITIES") + (push (cons 'priorities + (let ((prio (org-split-string value))) + (if (< (length prio) 3) '(?A ?C ?B) + (mapcar #'string-to-char prio)))) + alist)) + ((equal key "PROPERTY") + (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value) + (let* ((property (assq 'property alist)) + (value (org--update-property-plist + (org-match-string-no-properties 1 value) + (org-match-string-no-properties 2 value) + (cdr property)))) + (if property (setcdr property value) + (push (cons 'property value) alist))))) + ((equal key "STARTUP") + (let ((startup (assq 'startup alist))) + (if startup + (setcdr startup + (nconc (cdr startup) (org-split-string value))) + (push (cons 'startup (org-split-string value)) alist)))) + ((equal key "TAGS") + (let ((tag-cell (assq 'tags alist))) + (if tag-cell + (setcdr tag-cell + (nconc (cdr tag-cell) + '("\\n") + (org-split-string value))) + (push (cons 'tags (org-split-string value)) alist)))) + ((member key '("TODO" "SEQ_TODO" "TYP_TODO")) + (let ((todo (cdr (assq 'todo alist))) + (value (cons (if (equal key "TYP_TODO") 'type 'sequence) + (org-split-string value)))) + (if todo (push value todo) + (push (list 'todo value) alist)))) + ((equal key "SETUPFILE") + (unless buffer-read-only ; Do not check in Gnus messages. + (let ((f (expand-file-name (org-remove-double-quotes value)))) + (when (and (org-string-nw-p f) + (file-readable-p f) + (not (member f files))) + (with-temp-buffer + (let ((org-inhibit-startup t)) (org-mode)) + (insert-file-contents f) + (setq alist + (org--setup-collect-keywords + regexp alist (cons f files))))))))))))))) + alist) + +(defun org--setup-process-tags (tags filetags) + "Precompute variables used for tags. +TAGS is a list of tags and tag group symbols, as strings. +FILETAGS is a list of tags, as strings." + ;; Process the file tags. + (org-set-local 'org-file-tags + (mapcar #'org-add-prop-inherited filetags)) + ;; Provide default tags if no local tags are found. + (when (and (not tags) org-tag-alist) + (setq tags + (mapcar (lambda (tag) + (case (car tag) + (:startgroup "{") + (:endgroup "}") + (:grouptags ":") + (:newline "\\n") + (otherwise (concat (car tag) + (and (characterp (cdr tag)) + (format "(%c)" (cdr tag))))))) + org-tag-alist))) + ;; Process the tags. + (org-set-local 'org-tag-groups-alist nil) + (org-set-local 'org-tag-alist nil) + (let (group-flag) + (dolist (e tags) + (cond + ((equal e "{") + (push '(:startgroup) org-tag-alist) + (setq group-flag t)) + ((equal e "}") + (push '(:endgroup) org-tag-alist) + (setq group-flag nil)) + ((equal e ":") + (push '(:grouptags) org-tag-alist) + (setq group-flag 'append)) + ((equal e "\\n") (push '(:newline) org-tag-alist)) + ((string-match (org-re "\\`\\([[:alnum:]_@#%]+\\)\\(?:(\\(.\\))\\)?\\'") + e) + (let ((tag (match-string 1 e)) + (key (and (match-beginning 2) + (string-to-char (match-string 2 e))))) + (cond ((eq group-flag 'append) + (setcar org-tag-groups-alist + (append (car org-tag-groups-alist) (list tag)))) + (group-flag (push (list tag) org-tag-groups-alist))) + (unless (assoc tag org-tag-alist) + (push (cons tag key) org-tag-alist))))))) + (setq org-tag-alist (nreverse org-tag-alist))) (defun org-file-contents (file &optional noerror) "Return the contents of FILE, as a string." @@ -5419,7 +5418,6 @@ 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) (org-set-font-lock-defaults) (when (and org-tag-faces (not org-tags-special-faces-re)) @@ -18399,15 +18397,8 @@ 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-set-regexps-and-options 'tags-only) (setq pos (point)) - (goto-char (point-min)) - (let ((case-fold-search t)) - (when (search-forward "#+setupfile" nil t) - ;; Don't set all regexps and options systematically as - ;; this is only run for setting agenda tags from setup - ;; file - (org-set-regexps-and-options))) (or (memq 'category org-agenda-ignore-properties) (org-refresh-category-properties)) (or (memq 'stats org-agenda-ignore-properties) @@ -24397,12 +24388,13 @@ Show the heading too, if it is currently invisible." (org-cycle-hide-drawers 'children)))) (defun org-make-options-regexp (kwds &optional extra) - "Make a regular expression for keyword lines." - (concat - "^[ \t]*#\\+\\(" - (mapconcat 'regexp-quote kwds "\\|") - (if extra (concat "\\|" extra)) - "\\):[ \t]*\\(.*\\)")) + "Make a regular expression for keyword lines. +KWDS is a list of keywords, as strings. Optional argument EXTRA, +when non-nil, is a regexp matching keywords names." + (concat "^[ \t]*#\\+\\(" + (regexp-opt kwds) + (and extra (concat (and kwds "\\|") extra)) + "\\):[ \t]*\\(.*\\)")) ;; Make isearch reveal the necessary context (defun org-isearch-end ()