Fix a comment whitespace typo.
[emacs.git] / lisp / org / org-lint.el
blob5abda7c4a6b4917fa77e5fb264b2118523581e64
1 ;;; org-lint.el --- Linting for Org documents -*- lexical-binding: t; -*-
3 ;; Copyright (C) 2015-2017 Free Software Foundation, Inc.
5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
6 ;; Keywords: outlines, hypermedia, calendar, wp
8 ;; This file is part of GNU Emacs.
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation, either version 3 of the License, or
13 ;; (at your option) any later version.
15 ;; GNU Emacs is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
23 ;;; Commentary:
25 ;; This library implements linting for Org syntax. The sole public
26 ;; function is `org-lint', which see.
28 ;; Internally, the library defines a new structure:
29 ;; `org-lint-checker', with the following slots:
31 ;; - NAME: Unique check identifier, as a non-nil symbol that doesn't
32 ;; start with an hyphen.
34 ;; The check is done calling the function `org-lint-NAME' with one
35 ;; mandatory argument, the parse tree describing the current Org
36 ;; buffer. Such function calls are wrapped within
37 ;; a `save-excursion' and point is always at `point-min'. Its
38 ;; return value has to be an alist (POSITION MESSAGE) when
39 ;; POSITION refer to the buffer position of the error, as an
40 ;; integer, and MESSAGE is a string describing the error.
42 ;; - DESCRIPTION: Summary about the check, as a string.
44 ;; - CATEGORIES: Categories relative to the check, as a list of
45 ;; symbol. They are used for filtering when calling `org-lint'.
46 ;; Checkers not explicitly associated to a category are collected
47 ;; in the `default' one.
49 ;; - TRUST: The trust level one can have in the check. It is either
50 ;; `low' or `high', depending on the heuristics implemented and
51 ;; the nature of the check. This has an indicative value only and
52 ;; is displayed along reports.
54 ;; All checks have to be listed in `org-lint--checkers'.
56 ;; Results are displayed in a special "*Org Lint*" buffer with
57 ;; a dedicated major mode, derived from `tabulated-list-mode'.
59 ;; In addition to the usual key-bindings inherited from it, "C-j" and
60 ;; "TAB" display problematic line reported under point whereas "RET"
61 ;; jumps to it. Also, "h" hides all reports similar to the current
62 ;; one. Additionally, "i" removes them from subsequent reports.
64 ;; Checks currently implemented are:
66 ;; - duplicate CUSTOM_ID properties
67 ;; - duplicate NAME values
68 ;; - duplicate targets
69 ;; - duplicate footnote definitions
70 ;; - orphaned affiliated keywords
71 ;; - obsolete affiliated keywords
72 ;; - missing language in src blocks
73 ;; - missing back-end in export blocks
74 ;; - invalid Babel call blocks
75 ;; - NAME values with a colon
76 ;; - deprecated export block syntax
77 ;; - deprecated Babel header properties
78 ;; - wrong header arguments in src blocks
79 ;; - misuse of CATEGORY keyword
80 ;; - "coderef" links with unknown destination
81 ;; - "custom-id" links with unknown destination
82 ;; - "fuzzy" links with unknown destination
83 ;; - "id" links with unknown destination
84 ;; - links to non-existent local files
85 ;; - SETUPFILE keywords with non-existent file parameter
86 ;; - INCLUDE keywords with wrong link parameter
87 ;; - obsolete markup in INCLUDE keyword
88 ;; - unknown items in OPTIONS keyword
89 ;; - spurious macro arguments or invalid macro templates
90 ;; - special properties in properties drawer
91 ;; - obsolete syntax for PROPERTIES drawers
92 ;; - missing definition for footnote references
93 ;; - missing reference for footnote definitions
94 ;; - non-footnote definitions in footnote section
95 ;; - probable invalid keywords
96 ;; - invalid blocks
97 ;; - misplaced planning info line
98 ;; - incomplete drawers
99 ;; - indented diary-sexps
100 ;; - obsolete QUOTE section
101 ;; - obsolete "file+application" link
102 ;; - blank headlines with tags
105 ;;; Code:
107 (require 'cl-lib)
108 (require 'org-element)
109 (require 'org-macro)
110 (require 'ox)
111 (require 'ob)
114 ;;; Checkers
116 (cl-defstruct (org-lint-checker (:copier nil))
117 (name 'missing-checker-name)
118 (description "")
119 (categories '(default))
120 (trust 'high)) ; `low' or `high'
122 (defun org-lint-missing-checker-name (_)
123 (error
124 "`A checker has no `:name' property. Please verify `org-lint--checkers'"))
126 (defconst org-lint--checkers
127 (list
128 (make-org-lint-checker
129 :name 'duplicate-custom-id
130 :description "Report duplicates CUSTOM_ID properties"
131 :categories '(link))
132 (make-org-lint-checker
133 :name 'duplicate-name
134 :description "Report duplicate NAME values"
135 :categories '(babel link))
136 (make-org-lint-checker
137 :name 'duplicate-target
138 :description "Report duplicate targets"
139 :categories '(link))
140 (make-org-lint-checker
141 :name 'duplicate-footnote-definition
142 :description "Report duplicate footnote definitions"
143 :categories '(footnote))
144 (make-org-lint-checker
145 :name 'orphaned-affiliated-keywords
146 :description "Report orphaned affiliated keywords"
147 :trust 'low)
148 (make-org-lint-checker
149 :name 'obsolete-affiliated-keywords
150 :description "Report obsolete affiliated keywords"
151 :categories '(obsolete))
152 (make-org-lint-checker
153 :name 'deprecated-export-blocks
154 :description "Report deprecated export block syntax"
155 :categories '(obsolete export)
156 :trust 'low)
157 (make-org-lint-checker
158 :name 'deprecated-header-syntax
159 :description "Report deprecated Babel header syntax"
160 :categories '(obsolete babel)
161 :trust 'low)
162 (make-org-lint-checker
163 :name 'missing-language-in-src-block
164 :description "Report missing language in src blocks"
165 :categories '(babel))
166 (make-org-lint-checker
167 :name 'missing-backend-in-export-block
168 :description "Report missing back-end in export blocks"
169 :categories '(export))
170 (make-org-lint-checker
171 :name 'invalid-babel-call-block
172 :description "Report invalid Babel call blocks"
173 :categories '(babel))
174 (make-org-lint-checker
175 :name 'colon-in-name
176 :description "Report NAME values with a colon"
177 :categories '(babel))
178 (make-org-lint-checker
179 :name 'wrong-header-argument
180 :description "Report wrong babel headers"
181 :categories '(babel))
182 (make-org-lint-checker
183 :name 'wrong-header-value
184 :description "Report invalid value in babel headers"
185 :categories '(babel)
186 :trust 'low)
187 (make-org-lint-checker
188 :name 'deprecated-category-setup
189 :description "Report misuse of CATEGORY keyword"
190 :categories '(obsolete))
191 (make-org-lint-checker
192 :name 'invalid-coderef-link
193 :description "Report \"coderef\" links with unknown destination"
194 :categories '(link))
195 (make-org-lint-checker
196 :name 'invalid-custom-id-link
197 :description "Report \"custom-id\" links with unknown destination"
198 :categories '(link))
199 (make-org-lint-checker
200 :name 'invalid-fuzzy-link
201 :description "Report \"fuzzy\" links with unknown destination"
202 :categories '(link))
203 (make-org-lint-checker
204 :name 'invalid-id-link
205 :description "Report \"id\" links with unknown destination"
206 :categories '(link))
207 (make-org-lint-checker
208 :name 'link-to-local-file
209 :description "Report links to non-existent local files"
210 :categories '(link)
211 :trust 'low)
212 (make-org-lint-checker
213 :name 'non-existent-setupfile-parameter
214 :description "Report SETUPFILE keywords with non-existent file parameter"
215 :trust 'low)
216 (make-org-lint-checker
217 :name 'wrong-include-link-parameter
218 :description "Report INCLUDE keywords with misleading link parameter"
219 :categories '(export)
220 :trust 'low)
221 (make-org-lint-checker
222 :name 'obsolete-include-markup
223 :description "Report obsolete markup in INCLUDE keyword"
224 :categories '(obsolete export)
225 :trust 'low)
226 (make-org-lint-checker
227 :name 'unknown-options-item
228 :description "Report unknown items in OPTIONS keyword"
229 :categories '(export)
230 :trust 'low)
231 (make-org-lint-checker
232 :name 'invalid-macro-argument-and-template
233 :description "Report spurious macro arguments or invalid macro templates"
234 :categories '(export)
235 :trust 'low)
236 (make-org-lint-checker
237 :name 'special-property-in-properties-drawer
238 :description "Report special properties in properties drawers"
239 :categories '(properties))
240 (make-org-lint-checker
241 :name 'obsolete-properties-drawer
242 :description "Report obsolete syntax for properties drawers"
243 :categories '(obsolete properties))
244 (make-org-lint-checker
245 :name 'undefined-footnote-reference
246 :description "Report missing definition for footnote references"
247 :categories '(footnote))
248 (make-org-lint-checker
249 :name 'unreferenced-footnote-definition
250 :description "Report missing reference for footnote definitions"
251 :categories '(footnote))
252 (make-org-lint-checker
253 :name 'extraneous-element-in-footnote-section
254 :description "Report non-footnote definitions in footnote section"
255 :categories '(footnote))
256 (make-org-lint-checker
257 :name 'invalid-keyword-syntax
258 :description "Report probable invalid keywords"
259 :trust 'low)
260 (make-org-lint-checker
261 :name 'invalid-block
262 :description "Report invalid blocks"
263 :trust 'low)
264 (make-org-lint-checker
265 :name 'misplaced-planning-info
266 :description "Report misplaced planning info line"
267 :trust 'low)
268 (make-org-lint-checker
269 :name 'incomplete-drawer
270 :description "Report probable incomplete drawers"
271 :trust 'low)
272 (make-org-lint-checker
273 :name 'indented-diary-sexp
274 :description "Report probable indented diary-sexps"
275 :trust 'low)
276 (make-org-lint-checker
277 :name 'quote-section
278 :description "Report obsolete QUOTE section"
279 :categories '(obsolete)
280 :trust 'low)
281 (make-org-lint-checker
282 :name 'file-application
283 :description "Report obsolete \"file+application\" link"
284 :categories '(link obsolete))
285 (make-org-lint-checker
286 :name 'empty-headline-with-tags
287 :description "Report ambiguous empty headlines with tags"
288 :categories '(headline)
289 :trust 'low))
290 "List of all available checkers.")
292 (defun org-lint--collect-duplicates
293 (ast type extract-key extract-position build-message)
294 "Helper function to collect duplicates in parse tree AST.
296 EXTRACT-KEY is a function extracting key. It is called with
297 a single argument: the element or object. Comparison is done
298 with `equal'.
300 EXTRACT-POSITION is a function returning position for the report.
301 It is called with two arguments, the object or element, and the
302 key.
304 BUILD-MESSAGE is a function creating the report message. It is
305 called with one argument, the key used for comparison."
306 (let* (keys
307 originals
308 reports
309 (make-report
310 (lambda (position value)
311 (push (list position (funcall build-message value)) reports))))
312 (org-element-map ast type
313 (lambda (datum)
314 (let ((key (funcall extract-key datum)))
315 (cond
316 ((not key))
317 ((assoc key keys) (cl-pushnew (assoc key keys) originals)
318 (funcall make-report (funcall extract-position datum key) key))
319 (t (push (cons key (funcall extract-position datum key)) keys))))))
320 (dolist (e originals reports) (funcall make-report (cdr e) (car e)))))
322 (defun org-lint-duplicate-custom-id (ast)
323 (org-lint--collect-duplicates
325 'node-property
326 (lambda (property)
327 (and (eq (compare-strings "CUSTOM_ID" nil nil
328 (org-element-property :key property) nil nil
331 (org-element-property :value property)))
332 (lambda (property _) (org-element-property :begin property))
333 (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
335 (defun org-lint-duplicate-name (ast)
336 (org-lint--collect-duplicates
338 org-element-all-elements
339 (lambda (datum) (org-element-property :name datum))
340 (lambda (datum name)
341 (goto-char (org-element-property :begin datum))
342 (re-search-forward
343 (format "^[ \t]*#\\+[A-Za-z]+: +%s *$" (regexp-quote name)))
344 (match-beginning 0))
345 (lambda (key) (format "Duplicate NAME \"%s\"" key))))
347 (defun org-lint-duplicate-target (ast)
348 (org-lint--collect-duplicates
350 'target
351 (lambda (target) (org-split-string (org-element-property :value target)))
352 (lambda (target _) (org-element-property :begin target))
353 (lambda (key)
354 (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
356 (defun org-lint-duplicate-footnote-definition (ast)
357 (org-lint--collect-duplicates
359 'footnote-definition
360 (lambda (definition) (org-element-property :label definition))
361 (lambda (definition _) (org-element-property :post-affiliated definition))
362 (lambda (key) (format "Duplicate footnote definition \"%s\"" key))))
364 (defun org-lint-orphaned-affiliated-keywords (ast)
365 ;; Ignore orphan RESULTS keywords, which could be generated from
366 ;; a source block returning no value.
367 (let ((keywords (cl-set-difference org-element-affiliated-keywords
368 '("RESULT" "RESULTS")
369 :test #'equal)))
370 (org-element-map ast 'keyword
371 (lambda (k)
372 (let ((key (org-element-property :key k)))
373 (and (or (let ((case-fold-search t))
374 (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
375 (member key keywords))
376 (list (org-element-property :post-affiliated k)
377 (format "Orphaned affiliated keyword: \"%s\"" key))))))))
379 (defun org-lint-obsolete-affiliated-keywords (_)
380 (let ((regexp (format "^[ \t]*#\\+%s:"
381 (regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
382 "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
383 t)))
384 reports)
385 (while (re-search-forward regexp nil t)
386 (let ((key (upcase (match-string-no-properties 1))))
387 (when (< (point)
388 (org-element-property :post-affiliated (org-element-at-point)))
389 (push
390 (list (line-beginning-position)
391 (format
392 "Obsolete affiliated keyword: \"%s\". Use \"%s\" instead"
394 (pcase key
395 ("HEADERS" "HEADER")
396 ("RESULT" "RESULTS")
397 (_ "NAME"))))
398 reports))))
399 reports))
401 (defun org-lint-deprecated-export-blocks (ast)
402 (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
403 "ODT" "ORG" "TEXINFO")))
404 (org-element-map ast 'special-block
405 (lambda (b)
406 (let ((type (org-element-property :type b)))
407 (when (member-ignore-case type deprecated)
408 (list
409 (org-element-property :post-affiliated b)
410 (format
411 "Deprecated syntax for export block. Use \"BEGIN_EXPORT %s\" \
412 instead"
413 type))))))))
415 (defun org-lint-deprecated-header-syntax (ast)
416 (let* ((deprecated-babel-properties
417 (mapcar (lambda (arg) (symbol-name (car arg)))
418 org-babel-common-header-args-w-values))
419 (deprecated-re
420 (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
421 (org-element-map ast '(keyword node-property)
422 (lambda (datum)
423 (let ((key (org-element-property :key datum)))
424 (pcase (org-element-type datum)
425 (`keyword
426 (let ((value (org-element-property :value datum)))
427 (and (string= key "PROPERTY")
428 (string-match deprecated-re value)
429 (list (org-element-property :begin datum)
430 (format "Deprecated syntax for \"%s\". \
431 Use header-args instead"
432 (match-string-no-properties 1 value))))))
433 (`node-property
434 (and (member-ignore-case key deprecated-babel-properties)
435 (list
436 (org-element-property :begin datum)
437 (format "Deprecated syntax for \"%s\". \
438 Use :header-args: instead"
439 key))))))))))
441 (defun org-lint-missing-language-in-src-block (ast)
442 (org-element-map ast 'src-block
443 (lambda (b)
444 (unless (org-element-property :language b)
445 (list (org-element-property :post-affiliated b)
446 "Missing language in source block")))))
448 (defun org-lint-missing-backend-in-export-block (ast)
449 (org-element-map ast 'export-block
450 (lambda (b)
451 (unless (org-element-property :type b)
452 (list (org-element-property :post-affiliated b)
453 "Missing back-end in export block")))))
455 (defun org-lint-invalid-babel-call-block (ast)
456 (org-element-map ast 'babel-call
457 (lambda (b)
458 (cond
459 ((not (org-element-property :call b))
460 (list (org-element-property :post-affiliated b)
461 "Invalid syntax in babel call block"))
462 ((let ((h (org-element-property :end-header b)))
463 (and h (string-match-p "\\`\\[.*\\]\\'" h)))
464 (list
465 (org-element-property :post-affiliated b)
466 "Babel call's end header must not be wrapped within brackets"))))))
468 (defun org-lint-deprecated-category-setup (ast)
469 (org-element-map ast 'keyword
470 (let (category-flag)
471 (lambda (k)
472 (cond
473 ((not (string= (org-element-property :key k) "CATEGORY")) nil)
474 (category-flag
475 (list (org-element-property :post-affiliated k)
476 "Spurious CATEGORY keyword. Set :CATEGORY: property instead"))
477 (t (setf category-flag t) nil))))))
479 (defun org-lint-invalid-coderef-link (ast)
480 (let ((info (list :parse-tree ast)))
481 (org-element-map ast 'link
482 (lambda (link)
483 (let ((ref (org-element-property :path link)))
484 (and (equal (org-element-property :type link) "coderef")
485 (not (ignore-errors (org-export-resolve-coderef ref info)))
486 (list (org-element-property :begin link)
487 (format "Unknown coderef \"%s\"" ref))))))))
489 (defun org-lint-invalid-custom-id-link (ast)
490 (let ((info (list :parse-tree ast)))
491 (org-element-map ast 'link
492 (lambda (link)
493 (and (equal (org-element-property :type link) "custom-id")
494 (not (ignore-errors (org-export-resolve-id-link link info)))
495 (list (org-element-property :begin link)
496 (format "Unknown custom ID \"%s\""
497 (org-element-property :path link))))))))
499 (defun org-lint-invalid-fuzzy-link (ast)
500 (let ((info (list :parse-tree ast)))
501 (org-element-map ast 'link
502 (lambda (link)
503 (and (equal (org-element-property :type link) "fuzzy")
504 (not (ignore-errors (org-export-resolve-fuzzy-link link info)))
505 (list (org-element-property :begin link)
506 (format "Unknown fuzzy location \"%s\""
507 (let ((path (org-element-property :path link)))
508 (if (string-prefix-p "*" path)
509 (substring path 1)
510 path)))))))))
512 (defun org-lint-invalid-id-link (ast)
513 (org-element-map ast 'link
514 (lambda (link)
515 (let ((id (org-element-property :path link)))
516 (and (equal (org-element-property :type link) "id")
517 (not (org-id-find id))
518 (list (org-element-property :begin link)
519 (format "Unknown ID \"%s\"" id)))))))
521 (defun org-lint-special-property-in-properties-drawer (ast)
522 (org-element-map ast 'node-property
523 (lambda (p)
524 (let ((key (org-element-property :key p)))
525 (and (member-ignore-case key org-special-properties)
526 (list (org-element-property :begin p)
527 (format
528 "Special property \"%s\" found in a properties drawer"
529 key)))))))
531 (defun org-lint-obsolete-properties-drawer (ast)
532 (org-element-map ast 'drawer
533 (lambda (d)
534 (when (equal (org-element-property :drawer-name d) "PROPERTIES")
535 (let ((section (org-element-lineage d '(section))))
536 (unless (org-element-map section 'property-drawer #'identity nil t)
537 (list (org-element-property :post-affiliated d)
538 (if (save-excursion
539 (goto-char (org-element-property :post-affiliated d))
540 (forward-line -1)
541 (or (org-at-heading-p) (org-at-planning-p)))
542 "Incorrect contents for PROPERTIES drawer"
543 "Incorrect location for PROPERTIES drawer"))))))))
545 (defun org-lint-link-to-local-file (ast)
546 (org-element-map ast 'link
547 (lambda (l)
548 (when (equal (org-element-property :type l) "file")
549 (let ((file (org-link-unescape (org-element-property :path l))))
550 (and (not (file-remote-p file))
551 (not (file-exists-p file))
552 (list (org-element-property :begin l)
553 (format (if (org-element-lineage l '(link))
554 "Link to non-existent image file \"%s\"\
555 in link description"
556 "Link to non-existent local file \"%s\"")
557 file))))))))
559 (defun org-lint-non-existent-setupfile-parameter (ast)
560 (org-element-map ast 'keyword
561 (lambda (k)
562 (when (equal (org-element-property :key k) "SETUPFILE")
563 (let ((file (org-unbracket-string
564 "\"" "\""
565 (org-element-property :value k))))
566 (and (not (file-remote-p file))
567 (not (file-exists-p file))
568 (list (org-element-property :begin k)
569 (format "Non-existent setup file \"%s\"" file))))))))
571 (defun org-lint-wrong-include-link-parameter (ast)
572 (org-element-map ast 'keyword
573 (lambda (k)
574 (when (equal (org-element-property :key k) "INCLUDE")
575 (let* ((value (org-element-property :value k))
576 (path
577 (and (string-match "^\\(\".+\"\\|\\S-+\\)[ \t]*" value)
578 (save-match-data
579 (org-unbracket-string "\"" "\"" (match-string 1 value))))))
580 (if (not path)
581 (list (org-element-property :post-affiliated k)
582 "Missing location argument in INCLUDE keyword")
583 (let* ((file (org-string-nw-p
584 (if (string-match "::\\(.*\\)\\'" path)
585 (substring path 0 (match-beginning 0))
586 path)))
587 (search (and (not (equal file path))
588 (org-string-nw-p (match-string 1 path)))))
589 (if (and file
590 (not (file-remote-p file))
591 (not (file-exists-p file)))
592 (list (org-element-property :post-affiliated k)
593 "Non-existent file argument in INCLUDE keyword")
594 (let* ((visiting (if file (find-buffer-visiting file)
595 (current-buffer)))
596 (buffer (or visiting (find-file-noselect file))))
597 (unwind-protect
598 (with-current-buffer buffer
599 (when (and search
600 (not
601 (ignore-errors
602 (let ((org-link-search-inhibit-query t))
603 (org-link-search search nil t)))))
604 (list (org-element-property :post-affiliated k)
605 (format
606 "Invalid search part \"%s\" in INCLUDE keyword"
607 search))))
608 (unless visiting (kill-buffer buffer))))))))))))
610 (defun org-lint-obsolete-include-markup (ast)
611 (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
612 (regexp-opt
613 '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
614 "ODT" "ORG" "TEXINFO")
615 t))))
616 (org-element-map ast 'keyword
617 (lambda (k)
618 (when (equal (org-element-property :key k) "INCLUDE")
619 (let ((case-fold-search t)
620 (value (org-element-property :value k)))
621 (when (string-match regexp value)
622 (let ((markup (match-string-no-properties 1 value)))
623 (list (org-element-property :post-affiliated k)
624 (format "Obsolete markup \"%s\" in INCLUDE keyword. \
625 Use \"export %s\" instead"
626 markup
627 markup))))))))))
629 (defun org-lint-unknown-options-item (ast)
630 (let ((allowed (delq nil
631 (append
632 (mapcar (lambda (o) (nth 2 o)) org-export-options-alist)
633 (cl-mapcan
634 (lambda (b)
635 (mapcar (lambda (o) (nth 2 o))
636 (org-export-backend-options b)))
637 org-export-registered-backends))))
638 reports)
639 (org-element-map ast 'keyword
640 (lambda (k)
641 (when (string= (org-element-property :key k) "OPTIONS")
642 (let ((value (org-element-property :value k))
643 (start 0))
644 (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-*\\)[ \t]*"
645 value
646 start)
647 (setf start (match-end 0))
648 (let ((item (match-string 1 value)))
649 (unless (member item allowed)
650 (push (list (org-element-property :post-affiliated k)
651 (format "Unknown OPTIONS item \"%s\"" item))
652 reports))))))))
653 reports))
655 (defun org-lint-invalid-macro-argument-and-template (ast)
656 (let ((extract-placeholders
657 (lambda (template)
658 (let ((start 0)
659 args)
660 (while (string-match "\\$\\([1-9][0-9]*\\)" template start)
661 (setf start (match-end 0))
662 (push (string-to-number (match-string 1 template)) args))
663 (sort (org-uniquify args) #'<))))
664 reports)
665 ;; Check arguments for macro templates.
666 (org-element-map ast 'keyword
667 (lambda (k)
668 (when (string= (org-element-property :key k) "MACRO")
669 (let* ((value (org-element-property :value k))
670 (name (and (string-match "^\\S-+" value)
671 (match-string 0 value)))
672 (template (and name
673 (org-trim (substring value (match-end 0))))))
674 (cond
675 ((not name)
676 (push (list (org-element-property :post-affiliated k)
677 "Missing name in MACRO keyword")
678 reports))
679 ((not (org-string-nw-p template))
680 (push (list (org-element-property :post-affiliated k)
681 "Missing template in macro \"%s\"" name)
682 reports))
684 (unless (let ((args (funcall extract-placeholders template)))
685 (equal (number-sequence 1 (or (org-last args) 0)) args))
686 (push (list (org-element-property :post-affiliated k)
687 (format "Unused placeholders in macro \"%s\""
688 name))
689 reports))))))))
690 ;; Check arguments for macros.
691 (org-macro-initialize-templates)
692 (let ((templates (append
693 (mapcar (lambda (m) (cons m "$1"))
694 '("author" "date" "email" "title" "results"))
695 org-macro-templates)))
696 (org-element-map ast 'macro
697 (lambda (macro)
698 (let* ((name (org-element-property :key macro))
699 (template (cdr (assoc-string name templates t))))
700 (if (not template)
701 (push (list (org-element-property :begin macro)
702 (format "Undefined macro \"%s\"" name))
703 reports)
704 (let ((arg-numbers (funcall extract-placeholders template)))
705 (when arg-numbers
706 (let ((spurious-args
707 (nthcdr (apply #'max arg-numbers)
708 (org-element-property :args macro))))
709 (when spurious-args
710 (push
711 (list (org-element-property :begin macro)
712 (format "Unused argument%s in macro \"%s\": %s"
713 (if (> (length spurious-args) 1) "s" "")
714 name
715 (mapconcat (lambda (a) (format "\"%s\"" a))
716 spurious-args
717 ", ")))
718 reports))))))))))
719 reports))
721 (defun org-lint-undefined-footnote-reference (ast)
722 (let ((definitions (org-element-map ast 'footnote-definition
723 (lambda (f) (org-element-property :label f)))))
724 (org-element-map ast 'footnote-reference
725 (lambda (f)
726 (let ((label (org-element-property :label f)))
727 (and label
728 (not (member label definitions))
729 (list (org-element-property :begin f)
730 (format "Missing definition for footnote [%s]"
731 label))))))))
733 (defun org-lint-unreferenced-footnote-definition (ast)
734 (let ((references (org-element-map ast 'footnote-reference
735 (lambda (f) (org-element-property :label f)))))
736 (org-element-map ast 'footnote-definition
737 (lambda (f)
738 (let ((label (org-element-property :label f)))
739 (and label
740 (not (member label references))
741 (list (org-element-property :post-affiliated f)
742 (format "No reference for footnote definition [%s]"
743 label))))))))
745 (defun org-lint-colon-in-name (ast)
746 (org-element-map ast org-element-all-elements
747 (lambda (e)
748 (let ((name (org-element-property :name e)))
749 (and name
750 (string-match-p ":" name)
751 (list (progn
752 (goto-char (org-element-property :begin e))
753 (re-search-forward
754 (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name)))
755 (match-beginning 0))
756 (format
757 "Name \"%s\" contains a colon; Babel cannot use it as input"
758 name)))))))
760 (defun org-lint-misplaced-planning-info (_)
761 (let ((case-fold-search t)
762 reports)
763 (while (re-search-forward org-planning-line-re nil t)
764 (unless (memq (org-element-type (org-element-at-point))
765 '(comment-block example-block export-block planning
766 src-block verse-block))
767 (push (list (line-beginning-position) "Misplaced planning info line")
768 reports)))
769 reports))
771 (defun org-lint-incomplete-drawer (_)
772 (let (reports)
773 (while (re-search-forward org-drawer-regexp nil t)
774 (let ((name (org-trim (match-string-no-properties 0)))
775 (element (org-element-at-point)))
776 (pcase (org-element-type element)
777 ((or `drawer `property-drawer)
778 (goto-char (org-element-property :end element))
779 nil)
780 ((or `comment-block `example-block `export-block `src-block
781 `verse-block)
782 nil)
784 (push (list (line-beginning-position)
785 (format "Possible incomplete drawer \"%s\"" name))
786 reports)))))
787 reports))
789 (defun org-lint-indented-diary-sexp (_)
790 (let (reports)
791 (while (re-search-forward "^[ \t]+%%(" nil t)
792 (unless (memq (org-element-type (org-element-at-point))
793 '(comment-block diary-sexp example-block export-block
794 src-block verse-block))
795 (push (list (line-beginning-position) "Possible indented diary-sexp")
796 reports)))
797 reports))
799 (defun org-lint-invalid-block (_)
800 (let ((case-fold-search t)
801 (regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
802 reports)
803 (while (re-search-forward regexp nil t)
804 (let ((name (org-trim (buffer-substring-no-properties
805 (line-beginning-position) (line-end-position)))))
806 (cond
807 ((and (string-prefix-p "END" (match-string 1) t)
808 (not (eolp)))
809 (push (list (line-beginning-position)
810 (format "Invalid block closing line \"%s\"" name))
811 reports))
812 ((not (memq (org-element-type (org-element-at-point))
813 '(center-block comment-block dynamic-block example-block
814 export-block quote-block special-block
815 src-block verse-block)))
816 (push (list (line-beginning-position)
817 (format "Possible incomplete block \"%s\""
818 name))
819 reports)))))
820 reports))
822 (defun org-lint-invalid-keyword-syntax (_)
823 (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
824 (exception-re
825 (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
826 (regexp-opt org-element-dual-keywords)))
827 reports)
828 (while (re-search-forward regexp nil t)
829 (let ((name (match-string-no-properties 1)))
830 (unless (or (string-prefix-p "BEGIN" name t)
831 (string-prefix-p "END" name t)
832 (save-excursion
833 (beginning-of-line)
834 (let ((case-fold-search t)) (looking-at exception-re))))
835 (push (list (match-beginning 0)
836 (format "Possible missing colon in keyword \"%s\"" name))
837 reports))))
838 reports))
840 (defun org-lint-extraneous-element-in-footnote-section (ast)
841 (org-element-map ast 'headline
842 (lambda (h)
843 (and (org-element-property :footnote-section-p h)
844 (org-element-map (org-element-contents h)
845 (cl-remove-if
846 (lambda (e)
847 (memq e '(comment comment-block footnote-definition
848 property-drawer section)))
849 org-element-all-elements)
850 (lambda (e)
851 (not (and (eq (org-element-type e) 'headline)
852 (org-element-property :commentedp e))))
853 nil t '(footnote-definition property-drawer))
854 (list (org-element-property :begin h)
855 "Extraneous elements in footnote section are not exported")))))
857 (defun org-lint-quote-section (ast)
858 (org-element-map ast '(headline inlinetask)
859 (lambda (h)
860 (let ((title (org-element-property :raw-value h)))
861 (and (or (string-prefix-p "QUOTE " title)
862 (string-prefix-p (concat org-comment-string " QUOTE ") title))
863 (list (org-element-property :begin h)
864 "Deprecated QUOTE section"))))))
866 (defun org-lint-file-application (ast)
867 (org-element-map ast 'link
868 (lambda (l)
869 (let ((app (org-element-property :application l)))
870 (and app
871 (list (org-element-property :begin l)
872 (format "Deprecated \"file+%s\" link type" app)))))))
874 (defun org-lint-wrong-header-argument (ast)
875 (let* ((reports)
876 (verify
877 (lambda (datum language headers)
878 (let ((allowed
879 ;; If LANGUAGE is specified, restrict allowed
880 ;; headers to both LANGUAGE-specific and default
881 ;; ones. Otherwise, accept headers from any loaded
882 ;; language.
883 (append
884 org-babel-header-arg-names
885 (cl-mapcan
886 (lambda (l)
887 (let ((v (intern (format "org-babel-header-args:%s" l))))
888 (and (boundp v) (mapcar #'car (symbol-value v)))))
889 (if language (list language)
890 (mapcar #'car org-babel-load-languages))))))
891 (dolist (header headers)
892 (let ((h (symbol-name (car header)))
893 (p (or (org-element-property :post-affiliated datum)
894 (org-element-property :begin datum))))
895 (cond
896 ((not (string-prefix-p ":" h))
897 (push
898 (list p
899 (format "Missing colon in header argument \"%s\"" h))
900 reports))
901 ((assoc-string (substring h 1) allowed))
902 (t (push (list p (format "Unknown header argument \"%s\"" h))
903 reports)))))))))
904 (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword
905 node-property src-block)
906 (lambda (datum)
907 (pcase (org-element-type datum)
908 ((or `babel-call `inline-babel-call)
909 (funcall verify
910 datum
912 (cl-mapcan #'org-babel-parse-header-arguments
913 (list
914 (org-element-property :inside-header datum)
915 (org-element-property :end-header datum)))))
916 (`inline-src-block
917 (funcall verify
918 datum
919 (org-element-property :language datum)
920 (org-babel-parse-header-arguments
921 (org-element-property :parameters datum))))
922 (`keyword
923 (when (string= (org-element-property :key datum) "PROPERTY")
924 (let ((value (org-element-property :value datum)))
925 (when (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+? *"
926 value)
927 (funcall verify
928 datum
929 (match-string 1 value)
930 (org-babel-parse-header-arguments
931 (substring value (match-end 0))))))))
932 (`node-property
933 (let ((key (org-element-property :key datum)))
934 (when (let ((case-fold-search t))
935 (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+?"
936 key))
937 (funcall verify
938 datum
939 (match-string 1 key)
940 (org-babel-parse-header-arguments
941 (org-element-property :value datum))))))
942 (`src-block
943 (funcall verify
944 datum
945 (org-element-property :language datum)
946 (cl-mapcan #'org-babel-parse-header-arguments
947 (cons (org-element-property :parameters datum)
948 (org-element-property :header datum))))))))
949 reports))
951 (defun org-lint-wrong-header-value (ast)
952 (let (reports)
953 (org-element-map ast
954 '(babel-call inline-babel-call inline-src-block src-block)
955 (lambda (datum)
956 (let* ((type (org-element-type datum))
957 (language (org-element-property :language datum))
958 (allowed-header-values
959 (append (and language
960 (let ((v (intern (concat "org-babel-header-args:"
961 language))))
962 (and (boundp v) (symbol-value v))))
963 org-babel-common-header-args-w-values))
964 (datum-header-values
965 (org-babel-parse-header-arguments
966 (org-trim
967 (pcase type
968 (`src-block
969 (mapconcat
970 #'identity
971 (cons (org-element-property :parameters datum)
972 (org-element-property :header datum))
973 " "))
974 (`inline-src-block
975 (or (org-element-property :parameters datum) ""))
977 (concat
978 (org-element-property :inside-header datum)
980 (org-element-property :end-header datum))))))))
981 (dolist (header datum-header-values)
982 (let ((allowed-values
983 (cdr (assoc-string (substring (symbol-name (car header)) 1)
984 allowed-header-values))))
985 (unless (memq allowed-values '(:any nil))
986 (let ((values (cdr header))
987 groups-alist)
988 (dolist (v (if (stringp values) (org-split-string values)
989 (list values)))
990 (let ((valid-value nil))
991 (catch 'exit
992 (dolist (group allowed-values)
993 (cond
994 ((not (funcall
995 (if (stringp v) #'assoc-string #'assoc)
996 v group))
997 (when (memq :any group)
998 (setf valid-value t)
999 (push (cons group v) groups-alist)))
1000 ((assq group groups-alist)
1001 (push
1002 (list
1003 (or (org-element-property :post-affiliated datum)
1004 (org-element-property :begin datum))
1005 (format
1006 "Forbidden combination in header \"%s\": %s, %s"
1007 (car header)
1008 (cdr (assq group groups-alist))
1010 reports)
1011 (throw 'exit nil))
1012 (t (push (cons group v) groups-alist)
1013 (setf valid-value t))))
1014 (unless valid-value
1015 (push
1016 (list
1017 (or (org-element-property :post-affiliated datum)
1018 (org-element-property :begin datum))
1019 (format "Unknown value \"%s\" for header \"%s\""
1021 (car header)))
1022 reports))))))))))))
1023 reports))
1025 (defun org-lint-empty-headline-with-tags (ast)
1026 (org-element-map ast '(headline inlinetask)
1027 (lambda (h)
1028 (let ((title (org-element-property :raw-value h)))
1029 (and (string-match-p "\\`:[[:alnum:]_@#%:]+:\\'" title)
1030 (list (org-element-property :begin h)
1031 (format "Headline containing only tags is ambiguous: %S"
1032 title)))))))
1035 ;;; Reports UI
1037 (defvar org-lint--report-mode-map
1038 (let ((map (make-sparse-keymap)))
1039 (set-keymap-parent map tabulated-list-mode-map)
1040 (define-key map (kbd "RET") 'org-lint--jump-to-source)
1041 (define-key map (kbd "TAB") 'org-lint--show-source)
1042 (define-key map (kbd "C-j") 'org-lint--show-source)
1043 (define-key map (kbd "h") 'org-lint--hide-checker)
1044 (define-key map (kbd "i") 'org-lint--ignore-checker)
1045 map)
1046 "Local keymap for `org-lint--report-mode' buffers.")
1048 (define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
1049 "Major mode used to display reports emitted during linting.
1050 \\{org-lint--report-mode-map}"
1051 (setf tabulated-list-format
1052 `[("Line" 6
1053 (lambda (a b)
1054 (< (string-to-number (aref (cadr a) 0))
1055 (string-to-number (aref (cadr b) 0))))
1056 :right-align t)
1057 ("Trust" 5 t)
1058 ("Warning" 0 t)])
1059 (tabulated-list-init-header))
1061 (defun org-lint--generate-reports (buffer checkers)
1062 "Generate linting report for BUFFER.
1064 CHECKERS is the list of checkers used.
1066 Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
1067 for `tabulated-list-printer'."
1068 (with-current-buffer buffer
1069 (save-excursion
1070 (goto-char (point-min))
1071 (let ((ast (org-element-parse-buffer))
1072 (id 0)
1073 (last-line 1)
1074 (last-pos 1))
1075 ;; Insert unique ID for each report. Replace buffer positions
1076 ;; with line numbers.
1077 (mapcar
1078 (lambda (report)
1079 (list
1080 (cl-incf id)
1081 (apply #'vector
1082 (cons
1083 (progn
1084 (goto-char (car report))
1085 (beginning-of-line)
1086 (prog1 (number-to-string
1087 (cl-incf last-line
1088 (count-lines last-pos (point))))
1089 (setf last-pos (point))))
1090 (cdr report)))))
1091 ;; Insert trust level in generated reports. Also sort them
1092 ;; by buffer position in order to optimize lines computation.
1093 (sort (cl-mapcan
1094 (lambda (c)
1095 (let ((trust (symbol-name (org-lint-checker-trust c))))
1096 (mapcar
1097 (lambda (report)
1098 (list (car report) trust (nth 1 report) c))
1099 (save-excursion
1100 (funcall
1101 (intern (format "org-lint-%s"
1102 (org-lint-checker-name c)))
1103 ast)))))
1104 checkers)
1105 #'car-less-than-car))))))
1107 (defvar-local org-lint--source-buffer nil
1108 "Source buffer associated to current report buffer.")
1110 (defvar-local org-lint--local-checkers nil
1111 "List of checkers used to build current report.")
1113 (defun org-lint--refresh-reports ()
1114 (setq tabulated-list-entries
1115 (org-lint--generate-reports org-lint--source-buffer
1116 org-lint--local-checkers))
1117 (tabulated-list-print))
1119 (defun org-lint--current-line ()
1120 "Return current report line, as a number."
1121 (string-to-number (aref (tabulated-list-get-entry) 0)))
1123 (defun org-lint--current-checker (&optional entry)
1124 "Return current report checker.
1125 When optional argument ENTRY is non-nil, use this entry instead
1126 of current one."
1127 (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
1129 (defun org-lint--display-reports (source checkers)
1130 "Display linting reports for buffer SOURCE.
1131 CHECKERS is the list of checkers used."
1132 (let ((buffer (get-buffer-create "*Org Lint*")))
1133 (with-current-buffer buffer
1134 (org-lint--report-mode)
1135 (setf org-lint--source-buffer source)
1136 (setf org-lint--local-checkers checkers)
1137 (org-lint--refresh-reports)
1138 (tabulated-list-print)
1139 (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
1140 (pop-to-buffer buffer)))
1142 (defun org-lint--jump-to-source ()
1143 "Move to source line that generated the report at point."
1144 (interactive)
1145 (let ((l (org-lint--current-line)))
1146 (switch-to-buffer-other-window org-lint--source-buffer)
1147 (org-goto-line l)
1148 (org-show-set-visibility 'local)
1149 (recenter)))
1151 (defun org-lint--show-source ()
1152 "Show source line that generated the report at point."
1153 (interactive)
1154 (let ((buffer (current-buffer)))
1155 (org-lint--jump-to-source)
1156 (switch-to-buffer-other-window buffer)))
1158 (defun org-lint--hide-checker ()
1159 "Hide all reports from checker that generated the report at point."
1160 (interactive)
1161 (let ((c (org-lint--current-checker)))
1162 (setf tabulated-list-entries
1163 (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
1164 tabulated-list-entries))
1165 (tabulated-list-print)))
1167 (defun org-lint--ignore-checker ()
1168 "Ignore all reports from checker that generated the report at point.
1169 Checker will also be ignored in all subsequent reports."
1170 (interactive)
1171 (setf org-lint--local-checkers
1172 (remove (org-lint--current-checker) org-lint--local-checkers))
1173 (org-lint--hide-checker))
1176 ;;; Public function
1178 ;;;###autoload
1179 (defun org-lint (&optional arg)
1180 "Check current Org buffer for syntax mistakes.
1182 By default, run all checkers. With a `\\[universal-argument]' prefix ARG, \
1183 select one
1184 category of checkers only. With a `\\[universal-argument] \
1185 \\[universal-argument]' prefix, run one precise
1186 checker by its name.
1188 ARG can also be a list of checker names, as symbols, to run."
1189 (interactive "P")
1190 (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
1191 (when (called-interactively-p 'any)
1192 (message "Org linting process starting..."))
1193 (let ((checkers
1194 (pcase arg
1195 (`nil org-lint--checkers)
1196 (`(4)
1197 (let ((category
1198 (completing-read
1199 "Checker category: "
1200 (mapcar #'org-lint-checker-categories org-lint--checkers)
1201 nil t)))
1202 (cl-remove-if-not
1203 (lambda (c)
1204 (assoc-string (org-lint-checker-categories c) category))
1205 org-lint--checkers)))
1206 (`(16)
1207 (list
1208 (let ((name (completing-read
1209 "Checker name: "
1210 (mapcar #'org-lint-checker-name org-lint--checkers)
1211 nil t)))
1212 (catch 'exit
1213 (dolist (c org-lint--checkers)
1214 (when (string= (org-lint-checker-name c) name)
1215 (throw 'exit c)))))))
1216 ((pred consp)
1217 (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
1218 org-lint--checkers))
1219 (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
1220 (if (not (called-interactively-p 'any))
1221 (org-lint--generate-reports (current-buffer) checkers)
1222 (org-lint--display-reports (current-buffer) checkers)
1223 (message "Org linting process completed"))))
1226 (provide 'org-lint)
1227 ;;; org-lint.el ends here