From 148c5fa45e1fb8d58ecc86bb266d0fa33b8994a6 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?K=C3=A9vin=20Le=20Gouguec?= Date: Wed, 27 May 2020 22:53:56 +0200 Subject: [PATCH] Allow users to configure TODO keywords from dir-locals.el This uses the same method as AUCTeX and markdown-mode to refresh fontification based on file-local and directory-local variables: http://git.savannah.gnu.org/cgit/auctex.git/tree/font-latex.el?h=release_12_2#n1331 https://github.com/jrblevin/markdown-mode/blob/v2.4/markdown-mode.el#L9403 * lisp/org-faces.el (org-todo-keyword-faces): Add safe-local-variable predicate. * lisp/org.el (org-todo-keywords): Add safe-local-variable predicate. (org-set-regexps-and-options): Use buffer-local value of org-todo-keywords. (org-mode): Register a function to reset regexps and font-lock once file-local variables have been applied. (org--process-local-variables): Recompute regexps and font-lock if the user set relevant variables. * testing/examples/dir-locals/.dir-locals.el: * testing/examples/dir-locals/todo.org: Support files for new tests. * testing/lisp/test-org.el (test-org/dir-local-todo-keyword-faces): (test-org/dir-local-todo-cycling): New tests. --- lisp/org-faces.el | 10 ++++++- lisp/org.el | 28 +++++++++++++++---- testing/examples/dir-locals/.dir-locals.el | 11 ++++++++ testing/examples/dir-locals/todo.org | 8 ++++++ testing/lisp/test-org.el | 32 ++++++++++++++++++++++ 5 files changed, 82 insertions(+), 7 deletions(-) create mode 100644 testing/examples/dir-locals/.dir-locals.el create mode 100644 testing/examples/dir-locals/todo.org diff --git a/lisp/org-faces.el b/lisp/org-faces.el index d78b606ec..fc834f37d 100644 --- a/lisp/org-faces.el +++ b/lisp/org-faces.el @@ -291,7 +291,15 @@ determines if it is a foreground or a background color." (string :tag "Keyword") (choice :tag "Face " (string :tag "Color") - (sexp :tag "Face"))))) + (sexp :tag "Face")))) + :safe (lambda (x) + (cl-every + (lambda (pair) + (let ((keyword (car pair)) + (face (cdr pair))) + (and (stringp keyword) + (or (facep face) (listp face))))) + x))) (defface org-priority '((t :inherit font-lock-keyword-face)) "Face used for priority cookies." diff --git a/lisp/org.el b/lisp/org.el index 4d46b4173..c0183dbff 100644 --- a/lisp/org.el +++ b/lisp/org.el @@ -1945,7 +1945,13 @@ taken from the (otherwise obsolete) variable `org-todo-interpretation'." org-todo-interpretation-widgets)) widget)) (repeat - (string :tag "Keyword")))))) + (string :tag "Keyword"))))) + :safe (lambda (x) + (cl-every + (lambda (seq) + (and (memq (car seq) '(sequence type)) + (cl-every (lambda (i) (stringp i)) (cdr seq)))) + x))) (defvar-local org-todo-keywords-1 nil "All TODO and DONE keywords active in a buffer.") @@ -4358,10 +4364,9 @@ related expressions." (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))))))) + (if (not (stringp (car org-todo-keywords))) org-todo-keywords + ;; XXX: Backward compatibility code. + (list (cons org-todo-interpretation org-todo-keywords)))))) (dolist (sequence todo-sequences) (let* ((sequence (or (run-hook-with-args-until-success 'org-todo-setup-filter-hook sequence) @@ -4908,7 +4913,18 @@ The following commands are available: ;; Try to set `org-hide' face correctly. (let ((foreground (org-find-invisible-foreground))) (when foreground - (set-face-foreground 'org-hide foreground)))) + (set-face-foreground 'org-hide foreground))) + + (add-hook 'hack-local-variables-hook #'org--process-local-variables nil t)) + +(defun org--process-local-variables () + "Refresh settings affected by file-local or directory-local variables." + (when + (let ((local-vars (mapcar #'car file-local-variables-alist))) + (or (memq 'org-todo-keywords local-vars) + (memq 'org-todo-keyword-faces local-vars))) + (org-set-regexps-and-options) + (org-set-font-lock-defaults))) ;; Update `customize-package-emacs-version-alist' (add-to-list 'customize-package-emacs-version-alist diff --git a/testing/examples/dir-locals/.dir-locals.el b/testing/examples/dir-locals/.dir-locals.el new file mode 100644 index 000000000..677eaca10 --- /dev/null +++ b/testing/examples/dir-locals/.dir-locals.el @@ -0,0 +1,11 @@ +((org-mode + . ((org-todo-keywords + . ((sequence "TODO" "|" "DONE") + (sequence "REPORT" "BUG" "KNOWNCAUSE" "|" "FIXED") + (sequence "|" "CANCELED"))) + (org-todo-keyword-faces + . (("REPORT" . org-todo) + ("BUG" . warning) + ("KNOWNCAUSE" . warning) + ("FIXED" . org-done) + ("CANCELED" . shadow)))))) diff --git a/testing/examples/dir-locals/todo.org b/testing/examples/dir-locals/todo.org new file mode 100644 index 000000000..cd06b5ebd --- /dev/null +++ b/testing/examples/dir-locals/todo.org @@ -0,0 +1,8 @@ +#+Title: headings with TODO keywords set in .dir-locals.el +* TODO heading +* DONE heading +* REPORT heading +* BUG heading +* KNOWNCAUSE heading +* FIXED heading +* CANCELED heading diff --git a/testing/lisp/test-org.el b/testing/lisp/test-org.el index 375e1a718..2adcb2681 100644 --- a/testing/lisp/test-org.el +++ b/testing/lisp/test-org.el @@ -7158,6 +7158,38 @@ CLOCK: [2012-03-29 Thu 10:00]--[2012-03-29 Thu 16:40] => 6:40" (org-todo "DONE") (buffer-string)))))) +(ert-deftest test-org/dir-local-todo-keyword-faces () + "Make sure TODO faces honor dir-local variables." + (org-test-in-example-file + (expand-file-name "dir-locals/todo.org" org-test-example-dir) + (font-lock-ensure (point-min) (point-max)) + (dolist (expected-face '(org-todo + org-done + org-todo + warning + warning + org-done + shadow)) + (should (equal (get-text-property (+ 2 (point)) 'face) + expected-face)) + (next-line)))) + +(ert-deftest test-org/dir-local-todo-cycling () + "Make sure TODO cycling honors dir-local variables." + (org-test-in-example-file + (expand-file-name "dir-locals/todo.org" org-test-example-dir) + (dolist (expected-heading '("* DONE heading" + "* heading" + "* BUG heading" + "* KNOWNCAUSE heading" + "* FIXED heading" + "* heading" + "* heading")) + (org-todo) + (should (string= (buffer-substring (point) (line-end-position)) + expected-heading)) + (next-line)) + (revert-buffer t t))) ;;; Timestamps API -- 2.27.0