1 ;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015-2017 Free Software Foundation
5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
6 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;; GNU General Public License for more details.
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
23 ;; This library implements linting for Org syntax. The sole public
24 ;; function is `org-lint', which see.
26 ;; Internally, the library defines a new structure:
27 ;; `org-lint-checker', with the following slots:
29 ;; - NAME: Unique check identifier, as a non-nil symbol that doesn't
30 ;; start with an hyphen.
32 ;; The check is done calling the function `org-lint-NAME' with one
33 ;; mandatory argument, the parse tree describing the current Org
34 ;; buffer. Such function calls are wrapped within
35 ;; a `save-excursion' and point is always at `point-min'. Its
36 ;; return value has to be an alist (POSITION MESSAGE) when
37 ;; POSITION refer to the buffer position of the error, as an
38 ;; integer, and MESSAGE is a string describing the error.
40 ;; - DESCRIPTION: Summary about the check, as a string.
42 ;; - CATEGORIES: Categories relative to the check, as a list of
43 ;; symbol. They are used for filtering when calling `org-lint'.
44 ;; Checkers not explicitly associated to a category are collected
45 ;; in the `default' one.
47 ;; - TRUST: The trust level one can have in the check. It is either
48 ;; `low' or `high', depending on the heuristics implemented and
49 ;; the nature of the check. This has an indicative value only and
50 ;; is displayed along reports.
52 ;; All checks have to be listed in `org-lint--checkers'.
54 ;; Results are displayed in a special "*Org Lint*" buffer with
55 ;; a dedicated major mode, derived from `tabulated-list-mode'.
57 ;; In addition to the usual key-bindings inherited from it, "C-j" and
58 ;; "TAB" display problematic line reported under point whereas "RET"
59 ;; jumps to it. Also, "h" hides all reports similar to the current
60 ;; one. Additionally, "i" removes them from subsequent reports.
62 ;; Checks currently implemented are:
64 ;; - duplicate CUSTOM_ID properties
65 ;; - duplicate NAME values
66 ;; - duplicate targets
67 ;; - duplicate footnote definitions
68 ;; - orphaned affiliated keywords
69 ;; - obsolete affiliated keywords
70 ;; - missing language in src blocks
71 ;; - missing back-end in export blocks
72 ;; - invalid Babel call blocks
73 ;; - NAME values with a colon
74 ;; - deprecated export block syntax
75 ;; - deprecated Babel header properties
76 ;; - wrong header arguments in src blocks
77 ;; - misuse of CATEGORY keyword
78 ;; - "coderef" links with unknown destination
79 ;; - "custom-id" links with unknown destination
80 ;; - "fuzzy" links with unknown destination
81 ;; - "id" links with unknown destination
82 ;; - links to non-existent local files
83 ;; - SETUPFILE keywords with non-existent file parameter
84 ;; - INCLUDE keywords with wrong link parameter
85 ;; - obsolete markup in INCLUDE keyword
86 ;; - unknown items in OPTIONS keyword
87 ;; - spurious macro arguments or invalid macro templates
88 ;; - special properties in properties drawer
89 ;; - obsolete syntax for PROPERTIES drawers
90 ;; - missing definition for footnote references
91 ;; - missing reference for footnote definitions
92 ;; - non-footnote definitions in footnote section
93 ;; - probable invalid keywords
95 ;; - misplaced planning info line
96 ;; - incomplete drawers
97 ;; - indented diary-sexps
98 ;; - obsolete QUOTE section
99 ;; - obsolete "file+application" link
100 ;; - blank headlines with tags
106 (require 'org-element
)
114 (cl-defstruct (org-lint-checker (:copier nil
))
115 (name 'missing-checker-name
)
117 (categories '(default))
118 (trust 'high
)) ; `low' or `high'
120 (defun org-lint-missing-checker-name (_)
122 "`A checker has no `:name' property. Please verify `org-lint--checkers'"))
124 (defconst org-lint--checkers
126 (make-org-lint-checker
127 :name
'duplicate-custom-id
128 :description
"Report duplicates CUSTOM_ID properties"
130 (make-org-lint-checker
131 :name
'duplicate-name
132 :description
"Report duplicate NAME values"
133 :categories
'(babel link
))
134 (make-org-lint-checker
135 :name
'duplicate-target
136 :description
"Report duplicate targets"
138 (make-org-lint-checker
139 :name
'duplicate-footnote-definition
140 :description
"Report duplicate footnote definitions"
141 :categories
'(footnote))
142 (make-org-lint-checker
143 :name
'orphaned-affiliated-keywords
144 :description
"Report orphaned affiliated keywords"
146 (make-org-lint-checker
147 :name
'obsolete-affiliated-keywords
148 :description
"Report obsolete affiliated keywords"
149 :categories
'(obsolete))
150 (make-org-lint-checker
151 :name
'deprecated-export-blocks
152 :description
"Report deprecated export block syntax"
153 :categories
'(obsolete export
)
155 (make-org-lint-checker
156 :name
'deprecated-header-syntax
157 :description
"Report deprecated Babel header syntax"
158 :categories
'(obsolete babel
)
160 (make-org-lint-checker
161 :name
'missing-language-in-src-block
162 :description
"Report missing language in src blocks"
163 :categories
'(babel))
164 (make-org-lint-checker
165 :name
'missing-backend-in-export-block
166 :description
"Report missing back-end in export blocks"
167 :categories
'(export))
168 (make-org-lint-checker
169 :name
'invalid-babel-call-block
170 :description
"Report invalid Babel call blocks"
171 :categories
'(babel))
172 (make-org-lint-checker
174 :description
"Report NAME values with a colon"
175 :categories
'(babel))
176 (make-org-lint-checker
177 :name
'wrong-header-argument
178 :description
"Report wrong babel headers"
179 :categories
'(babel))
180 (make-org-lint-checker
181 :name
'wrong-header-value
182 :description
"Report invalid value in babel headers"
185 (make-org-lint-checker
186 :name
'deprecated-category-setup
187 :description
"Report misuse of CATEGORY keyword"
188 :categories
'(obsolete))
189 (make-org-lint-checker
190 :name
'invalid-coderef-link
191 :description
"Report \"coderef\" links with unknown destination"
193 (make-org-lint-checker
194 :name
'invalid-custom-id-link
195 :description
"Report \"custom-id\" links with unknown destination"
197 (make-org-lint-checker
198 :name
'invalid-fuzzy-link
199 :description
"Report \"fuzzy\" links with unknown destination"
201 (make-org-lint-checker
202 :name
'invalid-id-link
203 :description
"Report \"id\" links with unknown destination"
205 (make-org-lint-checker
206 :name
'link-to-local-file
207 :description
"Report links to non-existent local files"
210 (make-org-lint-checker
211 :name
'non-existent-setupfile-parameter
212 :description
"Report SETUPFILE keywords with non-existent file parameter"
214 (make-org-lint-checker
215 :name
'wrong-include-link-parameter
216 :description
"Report INCLUDE keywords with misleading link parameter"
217 :categories
'(export)
219 (make-org-lint-checker
220 :name
'obsolete-include-markup
221 :description
"Report obsolete markup in INCLUDE keyword"
222 :categories
'(obsolete export
)
224 (make-org-lint-checker
225 :name
'unknown-options-item
226 :description
"Report unknown items in OPTIONS keyword"
227 :categories
'(export)
229 (make-org-lint-checker
230 :name
'invalid-macro-argument-and-template
231 :description
"Report spurious macro arguments or invalid macro templates"
232 :categories
'(export)
234 (make-org-lint-checker
235 :name
'special-property-in-properties-drawer
236 :description
"Report special properties in properties drawers"
237 :categories
'(properties))
238 (make-org-lint-checker
239 :name
'obsolete-properties-drawer
240 :description
"Report obsolete syntax for properties drawers"
241 :categories
'(obsolete properties
))
242 (make-org-lint-checker
243 :name
'undefined-footnote-reference
244 :description
"Report missing definition for footnote references"
245 :categories
'(footnote))
246 (make-org-lint-checker
247 :name
'unreferenced-footnote-definition
248 :description
"Report missing reference for footnote definitions"
249 :categories
'(footnote))
250 (make-org-lint-checker
251 :name
'extraneous-element-in-footnote-section
252 :description
"Report non-footnote definitions in footnote section"
253 :categories
'(footnote))
254 (make-org-lint-checker
255 :name
'invalid-keyword-syntax
256 :description
"Report probable invalid keywords"
258 (make-org-lint-checker
260 :description
"Report invalid blocks"
262 (make-org-lint-checker
263 :name
'misplaced-planning-info
264 :description
"Report misplaced planning info line"
266 (make-org-lint-checker
267 :name
'incomplete-drawer
268 :description
"Report probable incomplete drawers"
270 (make-org-lint-checker
271 :name
'indented-diary-sexp
272 :description
"Report probable indented diary-sexps"
274 (make-org-lint-checker
276 :description
"Report obsolete QUOTE section"
277 :categories
'(obsolete)
279 (make-org-lint-checker
280 :name
'file-application
281 :description
"Report obsolete \"file+application\" link"
282 :categories
'(link obsolete
))
283 (make-org-lint-checker
284 :name
'empty-headline-with-tags
285 :description
"Report ambiguous empty headlines with tags"
286 :categories
'(headline)
288 "List of all available checkers.")
290 (defun org-lint--collect-duplicates
291 (ast type extract-key extract-position build-message
)
292 "Helper function to collect duplicates in parse tree AST.
294 EXTRACT-KEY is a function extracting key. It is called with
295 a single argument: the element or object. Comparison is done
298 EXTRACT-POSITION is a function returning position for the report.
299 It is called with two arguments, the object or element, and the
302 BUILD-MESSAGE is a function creating the report message. It is
303 called with one argument, the key used for comparison."
308 (lambda (position value
)
309 (push (list position
(funcall build-message value
)) reports
))))
310 (org-element-map ast type
312 (let ((key (funcall extract-key datum
)))
315 ((assoc key keys
) (cl-pushnew (assoc key keys
) originals
)
316 (funcall make-report
(funcall extract-position datum key
) key
))
317 (t (push (cons key
(funcall extract-position datum key
)) keys
))))))
318 (dolist (e originals reports
) (funcall make-report
(cdr e
) (car e
)))))
320 (defun org-lint-duplicate-custom-id (ast)
321 (org-lint--collect-duplicates
325 (and (eq (compare-strings "CUSTOM_ID" nil nil
326 (org-element-property :key property
) nil nil
329 (org-element-property :value property
)))
330 (lambda (property _
) (org-element-property :begin property
))
331 (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key
))))
333 (defun org-lint-duplicate-name (ast)
334 (org-lint--collect-duplicates
336 org-element-all-elements
337 (lambda (datum) (org-element-property :name datum
))
339 (goto-char (org-element-property :begin datum
))
341 (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name
)))
343 (lambda (key) (format "Duplicate NAME \"%s\"" key
))))
345 (defun org-lint-duplicate-target (ast)
346 (org-lint--collect-duplicates
349 (lambda (target) (org-split-string (org-element-property :value target
)))
350 (lambda (target _
) (org-element-property :begin target
))
352 (format "Duplicate target <<%s>>" (mapconcat #'identity key
" ")))))
354 (defun org-lint-duplicate-footnote-definition (ast)
355 (org-lint--collect-duplicates
358 (lambda (definition) (org-element-property :label definition
))
359 (lambda (definition _
) (org-element-property :post-affiliated definition
))
360 (lambda (key) (format "Duplicate footnote definition \"%s\"" key
))))
362 (defun org-lint-orphaned-affiliated-keywords (ast)
363 ;; Ignore orphan RESULTS keywords, which could be generated from
364 ;; a source block returning no value.
365 (let ((keywords (cl-set-difference org-element-affiliated-keywords
366 '("RESULT" "RESULTS")
368 (org-element-map ast
'keyword
370 (let ((key (org-element-property :key k
)))
371 (and (or (let ((case-fold-search t
))
372 (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key
))
373 (member key keywords
))
374 (list (org-element-property :post-affiliated k
)
375 (format "Orphaned affiliated keyword: \"%s\"" key
))))))))
377 (defun org-lint-obsolete-affiliated-keywords (_)
378 (let ((regexp (format "^[ \t]*#\\+%s:"
379 (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
380 "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
383 (while (re-search-forward regexp nil t
)
384 (let ((key (upcase (match-string-no-properties 1))))
386 (org-element-property :post-affiliated
(org-element-at-point)))
388 (list (line-beginning-position)
390 "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead"
399 (defun org-lint-deprecated-export-blocks (ast)
400 (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
401 "ODT" "ORG" "TEXINFO")))
402 (org-element-map ast
'special-block
404 (let ((type (org-element-property :type b
)))
405 (when (member-ignore-case type deprecated
)
407 (org-element-property :post-affiliated b
)
409 "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
413 (defun org-lint-deprecated-header-syntax (ast)
414 (let* ((deprecated-babel-properties
415 (mapcar (lambda (arg) (symbol-name (car arg
)))
416 org-babel-common-header-args-w-values
))
418 (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t
))))
419 (org-element-map ast
'(keyword node-property
)
421 (let ((key (org-element-property :key datum
)))
422 (pcase (org-element-type datum
)
424 (let ((value (org-element-property :value datum
)))
425 (and (string= key
"PROPERTY")
426 (string-match deprecated-re value
)
427 (list (org-element-property :begin datum
)
428 (format "Deprecated syntax for \"%s\". \
429 Use header-args instead"
430 (match-string-no-properties 1 value
))))))
432 (and (member-ignore-case key deprecated-babel-properties
)
434 (org-element-property :begin datum
)
435 (format "Deprecated syntax for \"%s\". \
436 Use :header-args: instead"
439 (defun org-lint-missing-language-in-src-block (ast)
440 (org-element-map ast
'src-block
442 (unless (org-element-property :language b
)
443 (list (org-element-property :post-affiliated b
)
444 "Missing language in source block")))))
446 (defun org-lint-missing-backend-in-export-block (ast)
447 (org-element-map ast
'export-block
449 (unless (org-element-property :type b
)
450 (list (org-element-property :post-affiliated b
)
451 "Missing back-end in export block")))))
453 (defun org-lint-invalid-babel-call-block (ast)
454 (org-element-map ast
'babel-call
457 ((not (org-element-property :call b
))
458 (list (org-element-property :post-affiliated b
)
459 "Invalid syntax in babel call block"))
460 ((let ((h (org-element-property :end-header b
)))
461 (and h
(string-match-p "\\`\\[.*\\]\\'" h
)))
463 (org-element-property :post-affiliated b
)
464 "Babel call's end header must not be wrapped within brackets"))))))
466 (defun org-lint-deprecated-category-setup (ast)
467 (org-element-map ast
'keyword
471 ((not (string= (org-element-property :key k
) "CATEGORY")) nil
)
473 (list (org-element-property :post-affiliated k
)
474 "Spurious CATEGORY keyword. Set :CATEGORY: property instead"))
475 (t (setf category-flag t
) nil
))))))
477 (defun org-lint-invalid-coderef-link (ast)
478 (let ((info (list :parse-tree ast
)))
479 (org-element-map ast
'link
481 (let ((ref (org-element-property :path link
)))
482 (and (equal (org-element-property :type link
) "coderef")
483 (not (ignore-errors (org-export-resolve-coderef ref info
)))
484 (list (org-element-property :begin link
)
485 (format "Unknown coderef \"%s\"" ref
))))))))
487 (defun org-lint-invalid-custom-id-link (ast)
488 (let ((info (list :parse-tree ast
)))
489 (org-element-map ast
'link
491 (and (equal (org-element-property :type link
) "custom-id")
492 (not (ignore-errors (org-export-resolve-id-link link info
)))
493 (list (org-element-property :begin link
)
494 (format "Unknown custom ID \"%s\""
495 (org-element-property :path link
))))))))
497 (defun org-lint-invalid-fuzzy-link (ast)
498 (let ((info (list :parse-tree ast
)))
499 (org-element-map ast
'link
501 (and (equal (org-element-property :type link
) "fuzzy")
502 (not (ignore-errors (org-export-resolve-fuzzy-link link info
)))
503 (list (org-element-property :begin link
)
504 (format "Unknown fuzzy location \"%s\""
505 (let ((path (org-element-property :path link
)))
506 (if (string-prefix-p "*" path
)
510 (defun org-lint-invalid-id-link (ast)
511 (org-element-map ast
'link
513 (let ((id (org-element-property :path link
)))
514 (and (equal (org-element-property :type link
) "id")
515 (not (org-id-find id
))
516 (list (org-element-property :begin link
)
517 (format "Unknown ID \"%s\"" id
)))))))
519 (defun org-lint-special-property-in-properties-drawer (ast)
520 (org-element-map ast
'node-property
522 (let ((key (org-element-property :key p
)))
523 (and (member-ignore-case key org-special-properties
)
524 (list (org-element-property :begin p
)
526 "Special property \"%s\" found in a properties drawer"
529 (defun org-lint-obsolete-properties-drawer (ast)
530 (org-element-map ast
'drawer
532 (when (equal (org-element-property :drawer-name d
) "PROPERTIES")
533 (let ((section (org-element-lineage d
'(section))))
534 (unless (org-element-map section
'property-drawer
#'identity nil t
)
535 (list (org-element-property :post-affiliated d
)
537 (goto-char (org-element-property :post-affiliated d
))
539 (or (org-at-heading-p) (org-at-planning-p)))
540 "Incorrect contents for PROPERTIES drawer"
541 "Incorrect location for PROPERTIES drawer"))))))))
543 (defun org-lint-link-to-local-file (ast)
544 (org-element-map ast
'link
546 (when (equal (org-element-property :type l
) "file")
547 (let ((file (org-link-unescape (org-element-property :path l
))))
548 (and (not (file-remote-p file
))
549 (not (file-exists-p file
))
550 (list (org-element-property :begin l
)
551 (format (if (org-element-lineage l
'(link))
552 "Link to non-existent image file \"%s\"\
554 "Link to non-existent local file \"%s\"")
557 (defun org-lint-non-existent-setupfile-parameter (ast)
558 (org-element-map ast
'keyword
560 (when (equal (org-element-property :key k
) "SETUPFILE")
561 (let ((file (org-unbracket-string
563 (org-element-property :value k
))))
564 (and (not (file-remote-p file
))
565 (not (file-exists-p file
))
566 (list (org-element-property :begin k
)
567 (format "Non-existent setup file \"%s\"" file
))))))))
569 (defun org-lint-wrong-include-link-parameter (ast)
570 (org-element-map ast
'keyword
572 (when (equal (org-element-property :key k
) "INCLUDE")
573 (let* ((value (org-element-property :value k
))
575 (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value
)
577 (org-unbracket-string "\"" "\"" (match-string 1 value
))))))
579 (list (org-element-property :post-affiliated k
)
580 "Missing location argument in INCLUDE keyword")
581 (let* ((file (org-string-nw-p
582 (if (string-match "::\\(.*\\)\\'" path
)
583 (substring path
0 (match-beginning 0))
585 (search (and (not (equal file path
))
586 (org-string-nw-p (match-string 1 path
)))))
588 (not (file-remote-p file
))
589 (not (file-exists-p file
)))
590 (list (org-element-property :post-affiliated k
)
591 "Non-existent file argument in INCLUDE keyword")
592 (let* ((visiting (if file
(find-buffer-visiting file
)
594 (buffer (or visiting
(find-file-noselect file
))))
596 (with-current-buffer buffer
600 (let ((org-link-search-inhibit-query t
))
601 (org-link-search search nil t
)))))
602 (list (org-element-property :post-affiliated k
)
604 "Invalid search part \"%s\" in INCLUDE keyword"
606 (unless visiting
(kill-buffer buffer
))))))))))))
608 (defun org-lint-obsolete-include-markup (ast)
609 (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
611 '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
612 "ODT" "ORG" "TEXINFO")
614 (org-element-map ast
'keyword
616 (when (equal (org-element-property :key k
) "INCLUDE")
617 (let ((case-fold-search t
)
618 (value (org-element-property :value k
)))
619 (when (string-match regexp value
)
620 (let ((markup (match-string-no-properties 1 value
)))
621 (list (org-element-property :post-affiliated k
)
622 (format "Obsolete markup \"%s\" in INCLUDE keyword. \
623 Use \"export %s\" instead"
627 (defun org-lint-unknown-options-item (ast)
628 (let ((allowed (delq nil
630 (mapcar (lambda (o) (nth 2 o
)) org-export-options-alist
)
633 (mapcar (lambda (o) (nth 2 o
))
634 (org-export-backend-options b
)))
635 org-export-registered-backends
))))
637 (org-element-map ast
'keyword
639 (when (string= (org-element-property :key k
) "OPTIONS")
640 (let ((value (org-element-property :value k
))
642 (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*"
645 (setf start
(match-end 0))
646 (let ((item (match-string 1 value
)))
647 (unless (member item allowed
)
648 (push (list (org-element-property :post-affiliated k
)
649 (format "Unknown OPTIONS item \"%s\"" item
))
653 (defun org-lint-invalid-macro-argument-and-template (ast)
654 (let ((extract-placeholders
658 (while (string-match "\\$\\([1-9][0-9]*\\)" template start
)
659 (setf start
(match-end 0))
660 (push (string-to-number (match-string 1 template
)) args
))
661 (sort (org-uniquify args
) #'<))))
663 ;; Check arguments for macro templates.
664 (org-element-map ast
'keyword
666 (when (string= (org-element-property :key k
) "MACRO")
667 (let* ((value (org-element-property :value k
))
668 (name (and (string-match "^\\S-+" value
)
669 (match-string 0 value
)))
671 (org-trim (substring value
(match-end 0))))))
674 (push (list (org-element-property :post-affiliated k
)
675 "Missing name in MACRO keyword")
677 ((not (org-string-nw-p template
))
678 (push (list (org-element-property :post-affiliated k
)
679 "Missing template in macro \"%s\"" name
)
682 (unless (let ((args (funcall extract-placeholders template
)))
683 (equal (number-sequence 1 (or (org-last args
) 0)) args
))
684 (push (list (org-element-property :post-affiliated k
)
685 (format "Unused placeholders in macro \"%s\""
688 ;; Check arguments for macros.
689 (org-macro-initialize-templates)
690 (let ((templates (append
691 (mapcar (lambda (m) (cons m
"$1"))
692 '("author" "date" "email" "title" "results"))
693 org-macro-templates
)))
694 (org-element-map ast
'macro
696 (let* ((name (org-element-property :key macro
))
697 (template (cdr (assoc-string name templates t
))))
699 (push (list (org-element-property :begin macro
)
700 (format "Undefined macro \"%s\"" name
))
702 (let ((arg-numbers (funcall extract-placeholders template
)))
705 (nthcdr (apply #'max arg-numbers
)
706 (org-element-property :args macro
))))
709 (list (org-element-property :begin macro
)
710 (format "Unused argument%s in macro \"%s\": %s"
711 (if (> (length spurious-args
) 1) "s" "")
713 (mapconcat (lambda (a) (format "\"%s\"" a
))
719 (defun org-lint-undefined-footnote-reference (ast)
720 (let ((definitions (org-element-map ast
'footnote-definition
721 (lambda (f) (org-element-property :label f
)))))
722 (org-element-map ast
'footnote-reference
724 (let ((label (org-element-property :label f
)))
726 (not (member label definitions
))
727 (list (org-element-property :begin f
)
728 (format "Missing definition for footnote [%s]"
731 (defun org-lint-unreferenced-footnote-definition (ast)
732 (let ((references (org-element-map ast
'footnote-reference
733 (lambda (f) (org-element-property :label f
)))))
734 (org-element-map ast
'footnote-definition
736 (let ((label (org-element-property :label f
)))
738 (not (member label references
))
739 (list (org-element-property :post-affiliated f
)
740 (format "No reference for footnote definition [%s]"
743 (defun org-lint-colon-in-name (ast)
744 (org-element-map ast org-element-all-elements
746 (let ((name (org-element-property :name e
)))
748 (string-match-p ":" name
)
750 (goto-char (org-element-property :begin e
))
752 (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name
)))
755 "Name \"%s\" contains a colon; Babel cannot use it as input"
758 (defun org-lint-misplaced-planning-info (_)
759 (let ((case-fold-search t
)
761 (while (re-search-forward org-planning-line-re nil t
)
762 (unless (memq (org-element-type (org-element-at-point))
763 '(comment-block example-block export-block planning
764 src-block verse-block
))
765 (push (list (line-beginning-position) "Misplaced planning info line")
769 (defun org-lint-incomplete-drawer (_)
771 (while (re-search-forward org-drawer-regexp nil t
)
772 (let ((name (org-trim (match-string-no-properties 0)))
773 (element (org-element-at-point)))
774 (pcase (org-element-type element
)
775 ((or `drawer
`property-drawer
)
776 (goto-char (org-element-property :end element
))
778 ((or `comment-block
`example-block
`export-block
`src-block
782 (push (list (line-beginning-position)
783 (format "Possible incomplete drawer \"%s\"" name
))
787 (defun org-lint-indented-diary-sexp (_)
789 (while (re-search-forward "^[ \t]+%%(" nil t
)
790 (unless (memq (org-element-type (org-element-at-point))
791 '(comment-block diary-sexp example-block export-block
792 src-block verse-block
))
793 (push (list (line-beginning-position) "Possible indented diary-sexp")
797 (defun org-lint-invalid-block (_)
798 (let ((case-fold-search t
)
799 (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
801 (while (re-search-forward regexp nil t
)
802 (let ((name (org-trim (buffer-substring-no-properties
803 (line-beginning-position) (line-end-position)))))
805 ((and (string-prefix-p "END" (match-string 1) t
)
807 (push (list (line-beginning-position)
808 (format "Invalid block closing line \"%s\"" name
))
810 ((not (memq (org-element-type (org-element-at-point))
811 '(center-block comment-block dynamic-block example-block
812 export-block quote-block special-block
813 src-block verse-block
)))
814 (push (list (line-beginning-position)
815 (format "Possible incomplete block \"%s\""
820 (defun org-lint-invalid-keyword-syntax (_)
821 (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
823 (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
824 (regexp-opt org-element-dual-keywords
)))
826 (while (re-search-forward regexp nil t
)
827 (let ((name (match-string-no-properties 1)))
828 (unless (or (string-prefix-p "BEGIN" name t
)
829 (string-prefix-p "END" name t
)
832 (let ((case-fold-search t
)) (looking-at exception-re
))))
833 (push (list (match-beginning 0)
834 (format "Possible missing colon in keyword \"%s\"" name
))
838 (defun org-lint-extraneous-element-in-footnote-section (ast)
839 (org-element-map ast
'headline
841 (and (org-element-property :footnote-section-p h
)
842 (org-element-map (org-element-contents h
)
845 (memq e
'(comment comment-block footnote-definition
846 property-drawer section
)))
847 org-element-all-elements
)
849 (not (and (eq (org-element-type e
) 'headline
)
850 (org-element-property :commentedp e
))))
851 nil t
'(footnote-definition property-drawer
))
852 (list (org-element-property :begin h
)
853 "Extraneous elements in footnote section are not exported")))))
855 (defun org-lint-quote-section (ast)
856 (org-element-map ast
'(headline inlinetask
)
858 (let ((title (org-element-property :raw-value h
)))
859 (and (or (string-prefix-p "QUOTE " title
)
860 (string-prefix-p (concat org-comment-string
" QUOTE ") title
))
861 (list (org-element-property :begin h
)
862 "Deprecated QUOTE section"))))))
864 (defun org-lint-file-application (ast)
865 (org-element-map ast
'link
867 (let ((app (org-element-property :application l
)))
869 (list (org-element-property :begin l
)
870 (format "Deprecated \"file+%s\" link type" app
)))))))
872 (defun org-lint-wrong-header-argument (ast)
875 (lambda (datum language headers
)
877 ;; If LANGUAGE is specified, restrict allowed
878 ;; headers to both LANGUAGE-specific and default
879 ;; ones. Otherwise, accept headers from any loaded
882 org-babel-header-arg-names
885 (let ((v (intern (format "org-babel-header-args:%s" l
))))
886 (and (boundp v
) (mapcar #'car
(symbol-value v
)))))
887 (if language
(list language
)
888 (mapcar #'car org-babel-load-languages
))))))
889 (dolist (header headers
)
890 (let ((h (symbol-name (car header
)))
891 (p (or (org-element-property :post-affiliated datum
)
892 (org-element-property :begin datum
))))
894 ((not (string-prefix-p ":" h
))
897 (format "Missing colon in header argument \"%s\"" h
))
899 ((assoc-string (substring h
1) allowed
))
900 (t (push (list p
(format "Unknown header argument \"%s\"" h
))
902 (org-element-map ast
'(babel-call inline-babel-call inline-src-block keyword
903 node-property src-block
)
905 (pcase (org-element-type datum
)
906 ((or `babel-call
`inline-babel-call
)
910 (cl-mapcan #'org-babel-parse-header-arguments
912 (org-element-property :inside-header datum
)
913 (org-element-property :end-header datum
)))))
917 (org-element-property :language datum
)
918 (org-babel-parse-header-arguments
919 (org-element-property :parameters datum
))))
921 (when (string= (org-element-property :key datum
) "PROPERTY")
922 (let ((value (org-element-property :value datum
)))
923 (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *"
927 (match-string 1 value
)
928 (org-babel-parse-header-arguments
929 (substring value
(match-end 0))))))))
931 (let ((key (org-element-property :key datum
)))
932 (when (let ((case-fold-search t
))
933 (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?"
938 (org-babel-parse-header-arguments
939 (org-element-property :value datum
))))))
943 (org-element-property :language datum
)
944 (cl-mapcan #'org-babel-parse-header-arguments
945 (cons (org-element-property :parameters datum
)
946 (org-element-property :header datum
))))))))
949 (defun org-lint-wrong-header-value (ast)
952 '(babel-call inline-babel-call inline-src-block src-block
)
954 (let* ((type (org-element-type datum
))
955 (language (org-element-property :language datum
))
956 (allowed-header-values
957 (append (and language
958 (let ((v (intern (concat "org-babel-header-args:"
960 (and (boundp v
) (symbol-value v
))))
961 org-babel-common-header-args-w-values
))
963 (org-babel-parse-header-arguments
969 (cons (org-element-property :parameters datum
)
970 (org-element-property :header datum
))
973 (or (org-element-property :parameters datum
) ""))
976 (org-element-property :inside-header datum
)
978 (org-element-property :end-header datum
))))))))
979 (dolist (header datum-header-values
)
980 (let ((allowed-values
981 (cdr (assoc-string (substring (symbol-name (car header
)) 1)
982 allowed-header-values
))))
983 (unless (memq allowed-values
'(:any nil
))
984 (let ((values (cdr header
))
986 (dolist (v (if (stringp values
) (org-split-string values
)
988 (let ((valid-value nil
))
990 (dolist (group allowed-values
)
993 (if (stringp v
) #'assoc-string
#'assoc
)
995 (when (memq :any group
)
997 (push (cons group v
) groups-alist
)))
998 ((assq group groups-alist
)
1001 (or (org-element-property :post-affiliated datum
)
1002 (org-element-property :begin datum
))
1004 "Forbidden combination in header \"%s\": %s, %s"
1006 (cdr (assq group groups-alist
))
1010 (t (push (cons group v
) groups-alist
)
1011 (setf valid-value t
))))
1015 (or (org-element-property :post-affiliated datum
)
1016 (org-element-property :begin datum
))
1017 (format "Unknown value \"%s\" for header \"%s\""
1023 (defun org-lint-empty-headline-with-tags (ast)
1024 (org-element-map ast
'(headline inlinetask
)
1026 (let ((title (org-element-property :raw-value h
)))
1027 (and (string-match-p "\\`:[[:alnum:]_@#%:]+:\\'" title
)
1028 (list (org-element-property :begin h
)
1029 (format "Headline containing only tags is ambiguous: %S"
1035 (defvar org-lint--report-mode-map
1036 (let ((map (make-sparse-keymap)))
1037 (set-keymap-parent map tabulated-list-mode-map
)
1038 (define-key map
(kbd "RET") 'org-lint--jump-to-source
)
1039 (define-key map
(kbd "TAB") 'org-lint--show-source
)
1040 (define-key map
(kbd "C-j") 'org-lint--show-source
)
1041 (define-key map
(kbd "h") 'org-lint--hide-checker
)
1042 (define-key map
(kbd "i") 'org-lint--ignore-checker
)
1044 "Local keymap for `org-lint--report-mode' buffers.")
1046 (define-derived-mode org-lint--report-mode tabulated-list-mode
"OrgLint"
1047 "Major mode used to display reports emitted during linting.
1048 \\{org-lint--report-mode-map}"
1049 (setf tabulated-list-format
1052 (< (string-to-number (aref (cadr a
) 0))
1053 (string-to-number (aref (cadr b
) 0))))
1057 (tabulated-list-init-header))
1059 (defun org-lint--generate-reports (buffer checkers
)
1060 "Generate linting report for BUFFER.
1062 CHECKERS is the list of checkers used.
1064 Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
1065 for `tabulated-list-printer'."
1066 (with-current-buffer buffer
1068 (goto-char (point-min))
1069 (let ((ast (org-element-parse-buffer))
1073 ;; Insert unique ID for each report. Replace buffer positions
1074 ;; with line numbers.
1082 (goto-char (car report
))
1084 (prog1 (number-to-string
1086 (count-lines last-pos
(point))))
1087 (setf last-pos
(point))))
1089 ;; Insert trust level in generated reports. Also sort them
1090 ;; by buffer position in order to optimize lines computation.
1093 (let ((trust (symbol-name (org-lint-checker-trust c
))))
1096 (list (car report
) trust
(nth 1 report
) c
))
1099 (intern (format "org-lint-%s"
1100 (org-lint-checker-name c
)))
1103 #'car-less-than-car
))))))
1105 (defvar-local org-lint--source-buffer nil
1106 "Source buffer associated to current report buffer.")
1108 (defvar-local org-lint--local-checkers nil
1109 "List of checkers used to build current report.")
1111 (defun org-lint--refresh-reports ()
1112 (setq tabulated-list-entries
1113 (org-lint--generate-reports org-lint--source-buffer
1114 org-lint--local-checkers
))
1115 (tabulated-list-print))
1117 (defun org-lint--current-line ()
1118 "Return current report line, as a number."
1119 (string-to-number (aref (tabulated-list-get-entry) 0)))
1121 (defun org-lint--current-checker (&optional entry
)
1122 "Return current report checker.
1123 When optional argument ENTRY is non-nil, use this entry instead
1125 (aref (if entry
(nth 1 entry
) (tabulated-list-get-entry)) 3))
1127 (defun org-lint--display-reports (source checkers
)
1128 "Display linting reports for buffer SOURCE.
1129 CHECKERS is the list of checkers used."
1130 (let ((buffer (get-buffer-create "*Org Lint*")))
1131 (with-current-buffer buffer
1132 (org-lint--report-mode)
1133 (setf org-lint--source-buffer source
)
1134 (setf org-lint--local-checkers checkers
)
1135 (org-lint--refresh-reports)
1136 (tabulated-list-print)
1137 (add-hook 'tabulated-list-revert-hook
#'org-lint--refresh-reports nil t
))
1138 (pop-to-buffer buffer
)))
1140 (defun org-lint--jump-to-source ()
1141 "Move to source line that generated the report at point."
1143 (let ((l (org-lint--current-line)))
1144 (switch-to-buffer-other-window org-lint--source-buffer
)
1146 (org-show-set-visibility 'local
)
1149 (defun org-lint--show-source ()
1150 "Show source line that generated the report at point."
1152 (let ((buffer (current-buffer)))
1153 (org-lint--jump-to-source)
1154 (switch-to-buffer-other-window buffer
)))
1156 (defun org-lint--hide-checker ()
1157 "Hide all reports from checker that generated the report at point."
1159 (let ((c (org-lint--current-checker)))
1160 (setf tabulated-list-entries
1161 (cl-remove-if (lambda (e) (equal c
(org-lint--current-checker e
)))
1162 tabulated-list-entries
))
1163 (tabulated-list-print)))
1165 (defun org-lint--ignore-checker ()
1166 "Ignore all reports from checker that generated the report at point.
1167 Checker will also be ignored in all subsequent reports."
1169 (setf org-lint--local-checkers
1170 (remove (org-lint--current-checker) org-lint--local-checkers
))
1171 (org-lint--hide-checker))
1177 (defun org-lint (&optional arg
)
1178 "Check current Org buffer for syntax mistakes.
1180 By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
1182 category of checkers only. With a `\\[universal-argument] \
1183 \\[universal-argument]' prefix, run one precise
1184 checker by its name.
1186 ARG can also be a list of checker names, as symbols, to run."
1188 (unless (derived-mode-p 'org-mode
) (user-error "Not in an Org buffer"))
1189 (when (called-interactively-p 'any
)
1190 (message "Org linting process starting..."))
1193 (`nil org-lint--checkers
)
1197 "Checker category: "
1198 (mapcar #'org-lint-checker-categories org-lint--checkers
)
1202 (assoc-string (org-lint-checker-categories c
) category
))
1203 org-lint--checkers
)))
1206 (let ((name (completing-read
1208 (mapcar #'org-lint-checker-name org-lint--checkers
)
1211 (dolist (c org-lint--checkers
)
1212 (when (string= (org-lint-checker-name c
) name
)
1213 (throw 'exit c
)))))))
1215 (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c
) arg
))
1216 org-lint--checkers
))
1217 (_ (user-error "Invalid argument `%S' for `org-lint'" arg
)))))
1218 (if (not (called-interactively-p 'any
))
1219 (org-lint--generate-reports (current-buffer) checkers
)
1220 (org-lint--display-reports (current-buffer) checkers
)
1221 (message "Org linting process completed"))))
1225 ;;; org-lint.el ends here