summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorNicolas Goaziou <mail@nicolasgoaziou.fr>2014-10-14 10:53:29 +0200
committerNicolas Goaziou <mail@nicolasgoaziou.fr>2014-10-28 14:23:52 +0100
commit61a241f0dc07aef5a3a5c2bd037a197236bde2e6 (patch)
treeb51936997acc7325dcb0a8367e407b465937b04d
parent0b74864bfb3b4f08d5b297d2b63d9cbc17120e58 (diff)
downloadorg-mode-61a241f0dc07aef5a3a5c2bd037a197236bde2e6.tar.gz
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.
-rw-r--r--lisp/org-table.el18
-rwxr-xr-xlisp/org.el610
2 files changed, 301 insertions, 327 deletions
diff --git a/lisp/org-table.el b/lisp/org-table.el
index bdd4476..8f36d22 100644
--- a/lisp/org-table.el
+++ b/lisp/org-table.el
@@ -2996,24 +2996,6 @@ list, 'literal is for the format specifier L."
",") "]"))))
;;;###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.
With prefix arg ALL, do this for all lines in the table.
diff --git a/lisp/org.el b/lisp/org.el
index faa73e4..96829a7 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 ()