branch: externals/org
commit aa4cd87d86df6208acf008aa9307d87ef7b1dc44
Author: Jacob S. Gordon <[email protected]>
Commit: Ihor Radchenko <[email protected]>
org-lint: Add check for priorities
* lisp/org-lint.el (org-lint-priority): Raise warnings on headlines
containing out-of-bounds, invalid (e.g., `[#-1]', `[#AA]'), or
malformed (e.g., `[#1', `[#A') priorities.
* testing/lisp/test-org-lint.el (test-org-lint/priority): Add test.
* etc/ORG-NEWS (New features): Announce feature.
---
etc/ORG-NEWS | 6 ++++++
lisp/org-lint.el | 31 +++++++++++++++++++++++++++++++
testing/lisp/test-org-lint.el | 24 ++++++++++++++++++++++++
3 files changed, 61 insertions(+)
diff --git a/etc/ORG-NEWS b/etc/ORG-NEWS
index d37d7f6c5a..ec2b402b39 100644
--- a/etc/ORG-NEWS
+++ b/etc/ORG-NEWS
@@ -286,6 +286,12 @@ executable can be configured via =org-ditaa-exec=.
SVG output can now be generated; note, however, that this requires a
ditaa version of at least 0.11.0.
+*** ~org-lint~ now checks priorities
+
+Warnings are raised on headlines containing out-of-bounds, invalid
+(e.g., =[#-1]=, =[#AA]=), or malformed (e.g., =[#1=, =[#A=)
+priorities.
+
** New and changed options
# Changes dealing with changing default values of customizations,
diff --git a/lisp/org-lint.el b/lisp/org-lint.el
index 00bc9c3408..04474b4b02 100644
--- a/lisp/org-lint.el
+++ b/lisp/org-lint.el
@@ -1506,6 +1506,32 @@ Use \"export %s\" instead"
(format "Bullet counter \"%s\" is not the same with item position
%d. Consider adding manual [@%d] counter."
bullet (car (last true-number)) bullet-number))))))))
+(defun org-lint-priority (ast)
+ "Report out-of-bounds, invalid, and malformed priorities.
+Raise warnings on headlines containing out-of-bounds, invalid (e.g.,
+`[#-1]', `[#AA]'), or malformed (e.g., `[#1', `[#A') priorities."
+ (let ((bad-priority-rx (rx line-start ?\[ ?#
+ (group (zero-or-more (not (in ?\[ ?\]))))
+ (group (zero-or-more ?\])))))
+ (org-element-map ast 'headline
+ (lambda (headline)
+ (if-let* ((priority (org-element-property :priority headline)))
+ (when (and (not (org-priority-valid-value-p priority))
+ (org-priority-valid-value-p priority t))
+ (list (org-element-begin headline)
+ (format "Out-of-bounds priority '%s'"
+ (org-priority-to-string priority))))
+ (when-let* ((headline-value (org-element-property
+ :raw-value headline))
+ (matches (string-match bad-priority-rx
+ headline-value)))
+ (list (org-element-begin headline)
+ (if (string-empty-p (match-string 2 headline-value))
+ (format "Malformed priority '%s'"
+ (match-string 0 headline-value))
+ (format "Invalid priority '%s'"
+ (match-string 1 headline-value))))))))))
+
(defun org-lint-LaTeX-$ (ast)
"Report semi-obsolete $...$ LaTeX fragments.
AST is the buffer parse tree."
@@ -1864,6 +1890,11 @@ AST is the buffer parse tree."
#'org-lint-item-number
:categories '(plain-list))
+(org-lint-add-checker 'priority
+ "Report out-of-bounds, invalid, and malformed priorities."
+ #'org-lint-priority
+ :categories '(markup))
+
(org-lint-add-checker 'LaTeX-$
"Report potentially confusing $...$ LaTeX markup."
#'org-lint-LaTeX-$
diff --git a/testing/lisp/test-org-lint.el b/testing/lisp/test-org-lint.el
index dd22fa6821..a2c7a06e6a 100644
--- a/testing/lisp/test-org-lint.el
+++ b/testing/lisp/test-org-lint.el
@@ -648,5 +648,29 @@ SCHEDULED: <2012-03-29 thu.>"
(org-test-with-temp-text "[cite:@foo]"
(org-lint '(incomplete-citation)))))
+(ert-deftest test-org-lint/priority ()
+ "Test `org-lint-priority'."
+ (dolist (bounds '((0 . 10) (?A . ?K)))
+ (let* ((org-priority-highest (car bounds))
+ (org-priority-lowest (cdr bounds)))
+ (let ((valid-buffer (mapconcat
+ #'(lambda (p) (format "* [#%s]"
+ (org-priority-to-string p)))
+ (number-sequence org-priority-highest
+ org-priority-lowest) "\n")))
+ (should-not (org-test-with-temp-text valid-buffer
+ (org-lint '(priority)))))
+ (dolist (invalid-buffer
+ (let ((priorities (list (1- org-priority-highest)
+ (1+ org-priority-lowest)
+ (1- 0) (1+ ?Z) "" "]" "AA")))
+ (append
+ (mapcar #'(lambda (p) (format "* [#%s]" p))
+ priorities)
+ (mapcar #'(lambda (p) (format "* [#%s" p))
+ priorities))))
+ (should (org-test-with-temp-text invalid-buffer
+ (org-lint '(priority))))))))
+
(provide 'test-org-lint)
;;; test-org-lint.el ends here
