Better handling of filenames in `org-collect-keywords'

* lisp/org.el (org-collect-keywords):
(org--collect-keywords-1): Add a new argument to take into
consideration current directory.
This commit is contained in:
Nicolas Goaziou 2020-04-26 18:40:24 +02:00
parent b4e91b7e94
commit 053676d284

View file

@ -4439,7 +4439,7 @@ related expressions."
"[ \t]*$")) "[ \t]*$"))
(org-compute-latex-and-related-regexp))))) (org-compute-latex-and-related-regexp)))))
(defun org-collect-keywords (keywords &optional uniques) (defun org-collect-keywords (keywords &optional unique directory)
"Return values for KEYWORDS in current buffer, as an alist. "Return values for KEYWORDS in current buffer, as an alist.
KEYWORDS is a list of strings. Return value is a list of KEYWORDS is a list of strings. Return value is a list of
@ -4451,15 +4451,22 @@ where NAME is the upcase name of the keyword, and LIST-OF-VALUES
is a list of non-empty values, as strings, in order of appearance is a list of non-empty values, as strings, in order of appearance
in the buffer. in the buffer.
When KEYWORD appears in UNIQUES list, LIST-OF-VALUE is its first When KEYWORD appears in UNIQUE list, LIST-OF-VALUE is its first
value, empty or not, appearing in the buffer, as a string. value, empty or not, appearing in the buffer, as a string.
Values are collected even in SETUPFILES." When KEYWORD appears in DIRECTORIES, each value is a cons cell:
(VALUE . DIRECTORY)
where VALUE is the regular value, and DIRECTORY is the variable
`default-directory' for the buffer containing the keyword. This
is important for values containing relative file names, since the
function follows SETUPFILE keywords, and may change its working
directory."
(let* ((keywords (cons "SETUPFILE" (mapcar #'upcase keywords))) (let* ((keywords (cons "SETUPFILE" (mapcar #'upcase keywords)))
(uniques (mapcar #'upcase uniques)) (unique (mapcar #'upcase unique))
(alist (org--collect-keywords-1 (alist (org--collect-keywords-1
keywords keywords unique directory
uniques
(and buffer-file-name (list buffer-file-name)) (and buffer-file-name (list buffer-file-name))
nil))) nil)))
;; Re-order results. ;; Re-order results.
@ -4469,7 +4476,7 @@ Values are collected even in SETUPFILES."
(setcdr entry (nreverse value))))) (setcdr entry (nreverse value)))))
(nreverse alist))) (nreverse alist)))
(defun org--collect-keywords-1 (keywords uniques files alist) (defun org--collect-keywords-1 (keywords unique directory files alist)
(org-with-point-at 1 (org-with-point-at 1
(let ((case-fold-search t) (let ((case-fold-search t)
(regexp (org-make-options-regexp keywords))) (regexp (org-make-options-regexp keywords)))
@ -4494,10 +4501,18 @@ Values are collected even in SETUPFILES."
(let ((org-inhibit-startup t)) (org-mode)) (let ((org-inhibit-startup t)) (org-mode))
(setq alist (setq alist
(org--collect-keywords-1 (org--collect-keywords-1
keywords uniques (cons uri files) alist))))))) keywords unique directory
(cons uri files)
alist)))))))
(key (key
(let ((entry (assoc-string key alist t))) (let ((entry (assoc-string key alist t))
(cond ((member-ignore-case key uniques) (value
(cond ((not (member key directory)) value)
(buffer-file-name
(cons value
(file-name-directory buffer-file-name)))
(t (cons value default-directory)))))
(cond ((member key unique)
(push (cons key value) alist) (push (cons key value) alist)
(setq keywords (remove key keywords)) (setq keywords (remove key keywords))
(setq regexp (org-make-options-regexp keywords))) (setq regexp (org-make-options-regexp keywords)))