Function: org-set-regexps-and-options

org-set-regexps-and-options is a byte-compiled function defined in org.el.gz.

Signature

(org-set-regexps-and-options &optional TAGS-ONLY)

Documentation

Precompute regular expressions used in the current buffer.

When optional argument TAGS-ONLY is non-nil, only compute tags related expressions.

Source Code

;; Defined in /usr/src/emacs/lisp/org/org.el.gz
(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)
    (let ((alist (org-collect-keywords
		  (append '("FILETAGS" "TAGS")
			  (and (not tags-only)
			       '("ARCHIVE" "CATEGORY" "COLUMNS" "CONSTANTS"
				 "LINK" "OPTIONS" "PRIORITIES" "PROPERTY"
				 "SEQ_TODO" "STARTUP" "TODO" "TYP_TODO")))
		  '("ARCHIVE" "CATEGORY" "COLUMNS" "PRIORITIES"))))
      ;; Startup options.  Get this early since it does change
      ;; behavior for other options (e.g., tags).
      (let ((startup (cl-mapcan (lambda (value) (split-string value))
				(cdr (assoc "STARTUP" alist)))))
	(dolist (option startup)
	  (pcase (assoc-string option org-startup-options t)
	    (`(,_ ,variable ,value t)
	     (unless (listp (symbol-value variable))
	       (set (make-local-variable variable) nil))
	     (add-to-list variable value))
	    (`(,_ ,variable ,value . ,_)
	     (set (make-local-variable variable) value))
	    (_ nil))))
      (setq-local org-file-tags
		  (mapcar #'org-add-prop-inherited
			  (cl-mapcan (lambda (value)
				       (cl-mapcan
					(lambda (k) (org-split-string k ":"))
					(split-string value)))
				     (cdr (assoc "FILETAGS" alist)))))
      (setq org-current-tag-alist
	    (org--tag-add-to-alist
	     org-tag-persistent-alist
	     (let ((tags (cdr (assoc "TAGS" alist))))
	       (if tags
		   (org-tag-string-to-alist
		    (mapconcat #'identity tags "\n"))
		 org-tag-alist))))
      (setq org-tag-groups-alist
	    (org-tag-alist-to-groups org-current-tag-alist))
      (unless tags-only
	;; Properties.
	(let ((properties nil))
	  (dolist (value (cdr (assoc "PROPERTY" alist)))
	    (when (string-match "\\(\\S-+\\)[ \t]+\\(.*\\)" value)
	      (setq properties (org--update-property-plist
				(match-string-no-properties 1 value)
				(match-string-no-properties 2 value)
				properties))))
	  (setq-local org-keyword-properties properties))
	;; Archive location.
	(let ((archive (cdr (assoc "ARCHIVE" alist))))
	  (when archive (setq-local org-archive-location archive)))
	;; Category.
	(let ((category (cdr (assoc "CATEGORY" alist))))
	  (when category
	    (setq-local org-category (intern category))
	    (setq-local org-keyword-properties
			(org--update-property-plist
			 "CATEGORY" category org-keyword-properties))))
	;; Columns.
	(let ((column (cdr (assoc "COLUMNS" alist))))
	  (when column (setq-local org-columns-default-format column)))
	;; Constants.
	(let ((store nil))
	  (dolist (pair (cl-mapcan #'split-string
				   (cdr (assoc "CONSTANTS" alist))))
	    (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)))))
	  (setq org-table-formula-constants-local store))
	;; Link abbreviations.
	(let ((links
	       (delq nil
		     (mapcar
		      (lambda (value)
			(and (or
                              ;; "abbrev with spaces" spec
                              (string-match "\\`\"\\(.+[^\\]\\)\"[ \t]+\\(.+\\)" value)
                              ;; abbrev spec
                              (string-match "\\`\\(\\S-+\\)[ \t]+\\(.+\\)" value))
			     (cons (match-string-no-properties 1 value)
				   (match-string-no-properties 2 value))))
		      (cdr (assoc "LINK" alist))))))
	  (when links (setq org-link-abbrev-alist-local (nreverse links))))
	;; Priorities.
	(let ((value (cdr (assoc "PRIORITIES" alist))))
	  (pcase (and value (split-string value))
	    (`(,high ,low ,default . ,_)
	     (setq-local org-priority-highest (org-priority-to-value high))
	     (setq-local org-priority-lowest (org-priority-to-value low))
	     (setq-local org-priority-default (org-priority-to-value default)))))
	;; Scripts.
	(let ((value (cdr (assoc "OPTIONS" alist))))
	  (dolist (option value)
	    (when (string-match "\\^:\\(t\\|nil\\|{}\\)" option)
	      (setq-local org-use-sub-superscripts
			  (read (match-string 1 option))))))
	;; TODO keywords.
	(setq-local org-todo-kwd-alist nil)
	(setq-local org-todo-key-alist nil)
	(setq-local org-todo-key-trigger nil)
	(setq-local org-todo-keywords-1 nil)
	(setq-local org-done-keywords nil)
	(setq-local org-todo-heads nil)
	(setq-local org-todo-sets nil)
	(setq-local org-todo-log-states nil)
	(let ((todo-sequences
	       (or (append (mapcar (lambda (value)
				     (cons 'type (split-string value)))
				   (cdr (assoc "TYP_TODO" alist)))
			   (mapcar (lambda (value)
				     (cons 'sequence (split-string value)))
				   (append (cdr (assoc "TODO" alist))
					   (cdr (assoc "SEQ_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.
	(unless 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 "\\)?"
		      "\\(?: +\\(\\[#.\\]\\)\\)?"
		      "\\(?: +\\(.*?\\)\\)??"
		      "\\(?:[ \t]+\\(:[[:alnum:]_@#%:]+:\\)\\)?"
		      "[ \t]*$")
	      org-complex-heading-regexp-format
	      (concat "^\\(\\*+\\)"
		      "\\(?: +" org-todo-regexp "\\)?"
		      "\\(?: +\\(\\[#.\\]\\)\\)?"
		      "\\(?: +"
                      ;; Headline might be commented
                      "\\(?:" org-comment-string " +\\)?"
		      ;; Stats cookies can be stuck to body.
		      "\\(?:\\[[0-9%%/]+\\] *\\)*"
		      "\\(%s\\)"
		      "\\(?: *\\[[0-9%%/]+\\]\\)*"
		      "\\)"
		      "\\(?:[ \t]+\\(:[[:alnum:]_@#%%:]+:\\)\\)?"
		      "[ \t]*$")
	      org-todo-line-tags-regexp
	      (concat "^\\(\\*+\\)"
		      "\\(?: +" org-todo-regexp "\\)?"
		      "\\(?: +\\(.*?\\)\\)??"
		      "\\(?:[ \t]+\\(:[[:alnum:]:_@#%]+:\\)\\)?"
		      "[ \t]*$"))
	(org-compute-latex-and-related-regexp)))))