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.
This commit is contained in:
Nicolas Goaziou
parent
0b74864bfb
commit
61a241f0dc
|
|
@ -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.
|
||||
|
|
|
|||
610
lisp/org.el
610
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 ()
|
||||
|
|
|
|||
Loading…
Reference in New Issue