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