dotemacs

My Emacs configuration
git clone git://git.entf.net/dotemacs
Log | Files | Refs | LICENSE

org-lint.el (52169B)


      1 ;;; org-lint.el --- Linting for Org documents        -*- lexical-binding: t; -*-
      2 
      3 ;; Copyright (C) 2015-2023 Free Software Foundation, Inc.
      4 
      5 ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
      6 ;; Keywords: outlines, hypermedia, calendar, wp
      7 
      8 ;; This file is part of GNU Emacs.
      9 
     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.
     14 
     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.
     19 
     20 ;; You should have received a copy of the GNU General Public License
     21 ;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.
     22 
     23 ;;; Commentary:
     24 
     25 ;; This library implements linting for Org syntax.  The process is
     26 ;; started by calling `org-lint' command, which see.
     27 
     28 ;; New checkers are added by `org-lint-add-checker' function.
     29 ;; Internally, all checks are listed in `org-lint--checkers'.
     30 
     31 ;; Results are displayed in a special "*Org Lint*" buffer with
     32 ;; a dedicated major mode, derived from `tabulated-list-mode'.
     33 ;; In addition to the usual key-bindings inherited from it, "C-j" and
     34 ;; "TAB" display problematic line reported under point whereas "RET"
     35 ;; jumps to it.  Also, "h" hides all reports similar to the current
     36 ;; one.  Additionally, "i" removes them from subsequent reports.
     37 
     38 ;; Checks currently implemented report the following:
     39 
     40 ;; - duplicates CUSTOM_ID properties,
     41 ;; - duplicate NAME values,
     42 ;; - duplicate targets,
     43 ;; - duplicate footnote definitions,
     44 ;; - orphaned affiliated keywords,
     45 ;; - obsolete affiliated keywords,
     46 ;; - deprecated export block syntax,
     47 ;; - deprecated Babel header syntax,
     48 ;; - missing language in source blocks,
     49 ;; - missing back-end in export blocks,
     50 ;; - invalid Babel call blocks,
     51 ;; - NAME values with a colon,
     52 ;; - wrong babel headers,
     53 ;; - invalid value in babel headers,
     54 ;; - misuse of CATEGORY keyword,
     55 ;; - "coderef" links with unknown destination,
     56 ;; - "custom-id" links with unknown destination,
     57 ;; - "fuzzy" links with unknown destination,
     58 ;; - "id" links with unknown destination,
     59 ;; - links to non-existent local files,
     60 ;; - SETUPFILE keywords with non-existent file parameter,
     61 ;; - INCLUDE keywords with misleading link parameter,
     62 ;; - obsolete markup in INCLUDE keyword,
     63 ;; - unknown items in OPTIONS keyword,
     64 ;; - spurious macro arguments or invalid macro templates,
     65 ;; - special properties in properties drawers,
     66 ;; - obsolete syntax for properties drawers,
     67 ;; - invalid duration in EFFORT property,
     68 ;; - missing definition for footnote references,
     69 ;; - missing reference for footnote definitions,
     70 ;; - non-footnote definitions in footnote section,
     71 ;; - probable invalid keywords,
     72 ;; - invalid blocks,
     73 ;; - misplaced planning info line,
     74 ;; - probable incomplete drawers,
     75 ;; - probable indented diary-sexps,
     76 ;; - obsolete QUOTE section,
     77 ;; - obsolete "file+application" link,
     78 ;; - obsolete escape syntax in links,
     79 ;; - spurious colons in tags,
     80 ;; - invalid bibliography file,
     81 ;; - missing "print_bibliography" keyword,
     82 ;; - invalid value for "cite_export" keyword,
     83 ;; - incomplete citation object.
     84 
     85 
     86 ;;; Code:
     87 
     88 (require 'org-macs)
     89 (org-assert-version)
     90 
     91 (require 'cl-lib)
     92 (require 'ob)
     93 (require 'oc)
     94 (require 'ol)
     95 (require 'org-attach)
     96 (require 'org-macro)
     97 (require 'org-fold)
     98 (require 'ox)
     99 (require 'seq)
    100 
    101 
    102 ;;; Checkers structure
    103 
    104 (cl-defstruct (org-lint-checker (:copier nil))
    105   name summary function trust categories)
    106 
    107 (defvar org-lint--checkers nil
    108   "List of all available checkers.
    109 This list is populated by `org-lint-add-checker' function.")
    110 
    111 ;;;###autoload
    112 (defun org-lint-add-checker (name summary fun &rest props)
    113   "Add a new checker for linter.
    114 
    115 NAME is a unique check identifier, as a non-nil symbol.  SUMMARY
    116 is a short description of the check, as a string.
    117 
    118 The check is done calling the function FUN with one mandatory
    119 argument, the parse tree describing the current Org buffer.  Such
    120 function calls are wrapped within a `save-excursion' and point is
    121 always at `point-min'.  Its return value has to be an
    122 alist (POSITION MESSAGE) where POSITION refer to the buffer
    123 position of the error, as an integer, and MESSAGE is a one-line
    124 string describing the error.
    125 
    126 Optional argument PROPS provides additional information about the
    127 checker.  Currently, two properties are supported:
    128 
    129   `:categories'
    130 
    131      Categories relative to the check, as a list of symbol.  They
    132      are used for filtering when calling `org-lint'.  Checkers
    133      not explicitly associated to a category are collected in the
    134      `default' one.
    135 
    136   `:trust'
    137 
    138     The trust level one can have in the check.  It is either
    139     `low' or `high', depending on the heuristics implemented and
    140     the nature of the check.  This has an indicative value only
    141     and is displayed along reports."
    142   (declare (indent 1))
    143   ;; Sanity checks.
    144   (pcase name
    145     (`nil (error "Name field is mandatory for checkers"))
    146     ((pred symbolp) nil)
    147     (_ (error "Invalid type for name field")))
    148   (unless (functionp fun)
    149     (error "Checker field is expected to be a valid function"))
    150   ;; Install checker in `org-lint--checkers'; uniquify by name.
    151   (setq org-lint--checkers
    152         (cons (apply #'make-org-lint-checker
    153                      :name name
    154                      :summary summary
    155                      :function fun
    156                      props)
    157               (seq-remove (lambda (c) (eq name (org-lint-checker-name c)))
    158                           org-lint--checkers))))
    159 
    160 
    161 ;;; Reports UI
    162 
    163 (defvar org-lint--report-mode-map
    164   (let ((map (make-sparse-keymap)))
    165     (set-keymap-parent map tabulated-list-mode-map)
    166     (define-key map (kbd "RET") 'org-lint--jump-to-source)
    167     (define-key map (kbd "TAB") 'org-lint--show-source)
    168     (define-key map (kbd "C-j") 'org-lint--show-source)
    169     (define-key map (kbd "h") 'org-lint--hide-checker)
    170     (define-key map (kbd "i") 'org-lint--ignore-checker)
    171     map)
    172   "Local keymap for `org-lint--report-mode' buffers.")
    173 
    174 (define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
    175   "Major mode used to display reports emitted during linting.
    176 \\{org-lint--report-mode-map}"
    177   (setf tabulated-list-format
    178 	`[("Line" 6
    179 	   (lambda (a b)
    180 	     (< (string-to-number (aref (cadr a) 0))
    181 		(string-to-number (aref (cadr b) 0))))
    182 	   :right-align t)
    183 	  ("Trust" 5 t)
    184 	  ("Warning" 0 t)])
    185   (tabulated-list-init-header))
    186 
    187 (defun org-lint--generate-reports (buffer checkers)
    188   "Generate linting report for BUFFER.
    189 
    190 CHECKERS is the list of checkers used.
    191 
    192 Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
    193 for `tabulated-list-printer'."
    194   (with-current-buffer buffer
    195     (save-excursion
    196       (goto-char (point-min))
    197       (let ((ast (org-element-parse-buffer))
    198 	    (id 0)
    199 	    (last-line 1)
    200 	    (last-pos 1))
    201 	;; Insert unique ID for each report.  Replace buffer positions
    202 	;; with line numbers.
    203 	(mapcar
    204 	 (lambda (report)
    205 	   (list
    206 	    (cl-incf id)
    207 	    (apply #'vector
    208 		   (cons
    209 		    (progn
    210 		      (goto-char (car report))
    211 		      (beginning-of-line)
    212 		      (prog1 (number-to-string
    213 			      (cl-incf last-line
    214 				       (count-lines last-pos (point))))
    215 			(setf last-pos (point))))
    216 		    (cdr report)))))
    217 	 ;; Insert trust level in generated reports.  Also sort them
    218 	 ;; by buffer position in order to optimize lines computation.
    219 	 (sort (cl-mapcan
    220 		(lambda (c)
    221 		  (let ((trust (symbol-name (org-lint-checker-trust c))))
    222 		    (mapcar
    223 		     (lambda (report)
    224 		       (list (car report) trust (nth 1 report) c))
    225 		     (save-excursion
    226 		       (funcall (org-lint-checker-function c)
    227 			        ast)))))
    228 		checkers)
    229 	       #'car-less-than-car))))))
    230 
    231 (defvar-local org-lint--source-buffer nil
    232   "Source buffer associated to current report buffer.")
    233 
    234 (defvar-local org-lint--local-checkers nil
    235   "List of checkers used to build current report.")
    236 
    237 (defun org-lint--refresh-reports ()
    238   (setq tabulated-list-entries
    239 	(org-lint--generate-reports org-lint--source-buffer
    240 				    org-lint--local-checkers))
    241   (tabulated-list-print))
    242 
    243 (defun org-lint--current-line ()
    244   "Return current report line, as a number."
    245   (string-to-number (aref (tabulated-list-get-entry) 0)))
    246 
    247 (defun org-lint--current-checker (&optional entry)
    248   "Return current report checker.
    249 When optional argument ENTRY is non-nil, use this entry instead
    250 of current one."
    251   (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))
    252 
    253 (defun org-lint--display-reports (source checkers)
    254   "Display linting reports for buffer SOURCE.
    255 CHECKERS is the list of checkers used."
    256   (let ((buffer (get-buffer-create "*Org Lint*")))
    257     (with-current-buffer buffer
    258       (org-lint--report-mode)
    259       (setf org-lint--source-buffer source)
    260       (setf org-lint--local-checkers checkers)
    261       (org-lint--refresh-reports)
    262       (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
    263     (pop-to-buffer buffer)))
    264 
    265 (defun org-lint--jump-to-source ()
    266   "Move to source line that generated the report at point."
    267   (interactive)
    268   (let ((l (org-lint--current-line)))
    269     (switch-to-buffer-other-window org-lint--source-buffer)
    270     (org-goto-line l)
    271     (org-fold-show-set-visibility 'local)
    272     (recenter)))
    273 
    274 (defun org-lint--show-source ()
    275   "Show source line that generated the report at point."
    276   (interactive)
    277   (let ((buffer (current-buffer)))
    278     (org-lint--jump-to-source)
    279     (switch-to-buffer-other-window buffer)))
    280 
    281 (defun org-lint--hide-checker ()
    282   "Hide all reports from checker that generated the report at point."
    283   (interactive)
    284   (let ((c (org-lint--current-checker)))
    285     (setf tabulated-list-entries
    286 	  (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
    287 			tabulated-list-entries))
    288     (tabulated-list-print)))
    289 
    290 (defun org-lint--ignore-checker ()
    291   "Ignore all reports from checker that generated the report at point.
    292 Checker will also be ignored in all subsequent reports."
    293   (interactive)
    294   (setf org-lint--local-checkers
    295 	(remove (org-lint--current-checker) org-lint--local-checkers))
    296   (org-lint--hide-checker))
    297 
    298 
    299 ;;; Main function
    300 
    301 ;;;###autoload
    302 (defun org-lint (&optional arg)
    303   "Check current Org buffer for syntax mistakes.
    304 
    305 By default, run all checkers.  With a `\\[universal-argument]' prefix ARG, \
    306 select one
    307 category of checkers only.  With a `\\[universal-argument] \
    308 \\[universal-argument]' prefix, run one precise
    309 checker by its name.
    310 
    311 ARG can also be a list of checker names, as symbols, to run."
    312   (interactive "P")
    313   (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
    314   (when (called-interactively-p 'any)
    315     (message "Org linting process starting..."))
    316   (let ((checkers
    317 	 (pcase arg
    318 	   (`nil org-lint--checkers)
    319 	   (`(4)
    320 	    (let ((category
    321 		   (completing-read
    322 		    "Checker category: "
    323 		    (mapcar #'org-lint-checker-categories org-lint--checkers)
    324 		    nil t)))
    325 	      (cl-remove-if-not
    326 	       (lambda (c)
    327 		 (assoc-string category (org-lint-checker-categories c)))
    328 	       org-lint--checkers)))
    329 	   (`(16)
    330 	    (list
    331 	     (let ((name (completing-read
    332 			  "Checker name: "
    333 			  (mapcar #'org-lint-checker-name org-lint--checkers)
    334 			  nil t)))
    335 	       (catch 'exit
    336 		 (dolist (c org-lint--checkers)
    337 		   (when (string= (org-lint-checker-name c) name)
    338 		     (throw 'exit c)))))))
    339 	   ((pred consp)
    340 	    (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
    341 			      org-lint--checkers))
    342 	   (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
    343     (if (not (called-interactively-p 'any))
    344 	(org-lint--generate-reports (current-buffer) checkers)
    345       (org-lint--display-reports (current-buffer) checkers)
    346       (message "Org linting process completed"))))
    347 
    348 
    349 ;;; Checker functions
    350 
    351 (defun org-lint--collect-duplicates
    352     (ast type extract-key extract-position build-message)
    353   "Helper function to collect duplicates in parse tree AST.
    354 
    355 EXTRACT-KEY is a function extracting key.  It is called with
    356 a single argument: the element or object.  Comparison is done
    357 with `equal'.
    358 
    359 EXTRACT-POSITION is a function returning position for the report.
    360 It is called with two arguments, the object or element, and the
    361 key.
    362 
    363 BUILD-MESSAGE is a function creating the report message.  It is
    364 called with one argument, the key used for comparison."
    365   (let* (keys
    366 	 originals
    367 	 reports
    368 	 (make-report
    369 	  (lambda (position value)
    370 	    (push (list position (funcall build-message value)) reports))))
    371     (org-element-map ast type
    372       (lambda (datum)
    373 	(let ((key (funcall extract-key datum)))
    374 	  (cond
    375 	   ((not key))
    376 	   ((assoc key keys) (cl-pushnew (assoc key keys) originals)
    377 	    (funcall make-report (funcall extract-position datum key) key))
    378 	   (t (push (cons key (funcall extract-position datum key)) keys))))))
    379     (dolist (e originals reports) (funcall make-report (cdr e) (car e)))))
    380 
    381 (defun org-lint-duplicate-custom-id (ast)
    382   (org-lint--collect-duplicates
    383    ast
    384    'node-property
    385    (lambda (property)
    386      (and (org-string-equal-ignore-case
    387            "CUSTOM_ID" (org-element-property :key property))
    388 	  (org-element-property :value property)))
    389    (lambda (property _) (org-element-property :begin property))
    390    (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))
    391 
    392 (defun org-lint-duplicate-name (ast)
    393   (org-lint--collect-duplicates
    394    ast
    395    org-element-all-elements
    396    (lambda (datum) (org-element-property :name datum))
    397    (lambda (datum name)
    398      (goto-char (org-element-property :begin datum))
    399      (re-search-forward
    400       (format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name)))
    401      (match-beginning 0))
    402    (lambda (key) (format "Duplicate NAME \"%s\"" key))))
    403 
    404 (defun org-lint-duplicate-target (ast)
    405   (org-lint--collect-duplicates
    406    ast
    407    'target
    408    (lambda (target) (split-string (org-element-property :value target)))
    409    (lambda (target _) (org-element-property :begin target))
    410    (lambda (key)
    411      (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))
    412 
    413 (defun org-lint-duplicate-footnote-definition (ast)
    414   (org-lint--collect-duplicates
    415    ast
    416    'footnote-definition
    417    (lambda (definition)  (org-element-property :label definition))
    418    (lambda (definition _) (org-element-property :post-affiliated definition))
    419    (lambda (key) (format "Duplicate footnote definition \"%s\"" key))))
    420 
    421 (defun org-lint-orphaned-affiliated-keywords (ast)
    422   ;; Ignore orphan RESULTS keywords, which could be generated from
    423   ;; a source block returning no value.
    424   (let ((keywords (cl-set-difference org-element-affiliated-keywords
    425 				     '("RESULT" "RESULTS")
    426 				     :test #'equal)))
    427     (org-element-map ast 'keyword
    428       (lambda (k)
    429 	(let ((key (org-element-property :key k)))
    430 	  (and (or (let ((case-fold-search t))
    431 		     (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
    432 		   (member key keywords))
    433 	       (list (org-element-property :post-affiliated k)
    434 		     (format "Orphaned affiliated keyword: \"%s\"" key))))))))
    435 
    436 (defun org-lint-obsolete-affiliated-keywords (_)
    437   (let ((regexp (format "^[ \t]*#\\+%s:"
    438 			(regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
    439 				      "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
    440 				    t)))
    441 	reports)
    442     (while (re-search-forward regexp nil t)
    443       (let ((key (upcase (match-string-no-properties 1))))
    444 	(when (< (point)
    445 		 (org-element-property :post-affiliated (org-element-at-point)))
    446 	  (push
    447 	   (list (line-beginning-position)
    448 		 (format
    449 		  "Obsolete affiliated keyword: \"%s\".  Use \"%s\" instead"
    450 		  key
    451 		  (pcase key
    452 		    ("HEADERS" "HEADER")
    453 		    ("RESULT" "RESULTS")
    454 		    (_ "NAME"))))
    455 	   reports))))
    456     reports))
    457 
    458 (defun org-lint-deprecated-export-blocks (ast)
    459   (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
    460 		      "ODT" "ORG" "TEXINFO")))
    461     (org-element-map ast 'special-block
    462       (lambda (b)
    463 	(let ((type (org-element-property :type b)))
    464 	  (when (member-ignore-case type deprecated)
    465 	    (list
    466 	     (org-element-property :post-affiliated b)
    467 	     (format
    468 	      "Deprecated syntax for export block.  Use \"BEGIN_EXPORT %s\" \
    469 instead"
    470 	      type))))))))
    471 
    472 (defun org-lint-deprecated-header-syntax (ast)
    473   (let* ((deprecated-babel-properties
    474 	  ;; DIR is also used for attachments.
    475 	  (delete "dir"
    476 		  (mapcar (lambda (arg) (downcase (symbol-name (car arg))))
    477 			  org-babel-common-header-args-w-values)))
    478 	 (deprecated-re
    479 	  (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
    480     (org-element-map ast '(keyword node-property)
    481       (lambda (datum)
    482 	(let ((key (org-element-property :key datum)))
    483 	  (pcase (org-element-type datum)
    484 	    (`keyword
    485 	     (let ((value (org-element-property :value datum)))
    486 	       (and (string= key "PROPERTY")
    487 		    (string-match deprecated-re value)
    488 		    (list (org-element-property :begin datum)
    489 			  (format "Deprecated syntax for \"%s\".  \
    490 Use header-args instead"
    491 				  (match-string-no-properties 1 value))))))
    492 	    (`node-property
    493 	     (and (member-ignore-case key deprecated-babel-properties)
    494 		  (list
    495 		   (org-element-property :begin datum)
    496 		   (format "Deprecated syntax for \"%s\".  \
    497 Use :header-args: instead"
    498 			   key))))))))))
    499 
    500 (defun org-lint-missing-language-in-src-block (ast)
    501   (org-element-map ast 'src-block
    502     (lambda (b)
    503       (unless (org-element-property :language b)
    504 	(list (org-element-property :post-affiliated b)
    505 	      "Missing language in source block")))))
    506 
    507 (defun org-lint-missing-backend-in-export-block (ast)
    508   (org-element-map ast 'export-block
    509     (lambda (b)
    510       (unless (org-element-property :type b)
    511 	(list (org-element-property :post-affiliated b)
    512 	      "Missing back-end in export block")))))
    513 
    514 (defun org-lint-invalid-babel-call-block (ast)
    515   (org-element-map ast 'babel-call
    516     (lambda (b)
    517       (cond
    518        ((not (org-element-property :call b))
    519 	(list (org-element-property :post-affiliated b)
    520 	      "Invalid syntax in babel call block"))
    521        ((let ((h (org-element-property :end-header b)))
    522 	  (and h (string-match-p "\\`\\[.*\\]\\'" h)))
    523 	(list
    524 	 (org-element-property :post-affiliated b)
    525 	 "Babel call's end header must not be wrapped within brackets"))))))
    526 
    527 (defun org-lint-deprecated-category-setup (ast)
    528   (org-element-map ast 'keyword
    529     (let (category-flag)
    530       (lambda (k)
    531 	(cond
    532 	 ((not (string= (org-element-property :key k) "CATEGORY")) nil)
    533 	 (category-flag
    534 	  (list (org-element-property :post-affiliated k)
    535 		"Spurious CATEGORY keyword.  Set :CATEGORY: property instead"))
    536 	 (t (setf category-flag t) nil))))))
    537 
    538 (defun org-lint-invalid-coderef-link (ast)
    539   (let ((info (list :parse-tree ast)))
    540     (org-element-map ast 'link
    541       (lambda (link)
    542 	(let ((ref (org-element-property :path link)))
    543 	  (and (equal (org-element-property :type link) "coderef")
    544 	       (not (ignore-errors (org-export-resolve-coderef ref info)))
    545 	       (list (org-element-property :begin link)
    546 		     (format "Unknown coderef \"%s\"" ref))))))))
    547 
    548 (defun org-lint-invalid-custom-id-link (ast)
    549   (let ((info (list :parse-tree ast)))
    550     (org-element-map ast 'link
    551       (lambda (link)
    552 	(and (equal (org-element-property :type link) "custom-id")
    553 	     (not (ignore-errors (org-export-resolve-id-link link info)))
    554 	     (list (org-element-property :begin link)
    555 		   (format "Unknown custom ID \"%s\""
    556 			   (org-element-property :path link))))))))
    557 
    558 (defun org-lint-invalid-fuzzy-link (ast)
    559   (let ((info (list :parse-tree ast)))
    560     (org-element-map ast 'link
    561       (lambda (link)
    562 	(and (equal (org-element-property :type link) "fuzzy")
    563 	     (not (ignore-errors (org-export-resolve-fuzzy-link link info)))
    564 	     (list (org-element-property :begin link)
    565 		   (format "Unknown fuzzy location \"%s\""
    566 			   (let ((path (org-element-property :path link)))
    567 			     (if (string-prefix-p "*" path)
    568 				 (substring path 1)
    569 			       path)))))))))
    570 
    571 (defun org-lint-invalid-id-link (ast)
    572   (org-element-map ast 'link
    573     (lambda (link)
    574       (let ((id (org-element-property :path link)))
    575 	(and (equal (org-element-property :type link) "id")
    576 	     (not (org-id-find id))
    577 	     (list (org-element-property :begin link)
    578 		   (format "Unknown ID \"%s\"" id)))))))
    579 
    580 (defun org-lint-special-property-in-properties-drawer (ast)
    581   (org-element-map ast 'node-property
    582     (lambda (p)
    583       (let ((key (org-element-property :key p)))
    584 	(and (member-ignore-case key org-special-properties)
    585 	     (list (org-element-property :begin p)
    586 		   (format
    587 		    "Special property \"%s\" found in a properties drawer"
    588 		    key)))))))
    589 
    590 (defun org-lint-obsolete-properties-drawer (ast)
    591   (org-element-map ast 'drawer
    592     (lambda (d)
    593       (when (equal (org-element-property :drawer-name d) "PROPERTIES")
    594 	(let ((headline? (org-element-lineage d '(headline)))
    595 	      (before
    596 	       (mapcar #'org-element-type
    597 		       (assq d (reverse (org-element-contents
    598 					 (org-element-property :parent d)))))))
    599 	  (list (org-element-property :post-affiliated d)
    600 		(if (or (and headline? (member before '(nil (planning))))
    601 			(and (null headline?) (member before '(nil (comment)))))
    602 		    "Incorrect contents for PROPERTIES drawer"
    603 		  "Incorrect location for PROPERTIES drawer")))))))
    604 
    605 (defun org-lint-invalid-effort-property (ast)
    606   (org-element-map ast 'node-property
    607     (lambda (p)
    608       (when (equal "EFFORT" (org-element-property :key p))
    609 	(let ((value (org-element-property :value p)))
    610 	  (and (org-string-nw-p value)
    611 	       (not (org-duration-p value))
    612 	       (list (org-element-property :begin p)
    613 		     (format "Invalid effort duration format: %S" value))))))))
    614 
    615 (defun org-lint-link-to-local-file (ast)
    616   (org-element-map ast 'link
    617     (lambda (l)
    618       (let ((type (org-element-property :type l)))
    619 	(pcase type
    620 	  ((or "attachment" "file")
    621 	   (let* ((path (org-element-property :path l))
    622 		  (file (if (string= type "file")
    623 			    path
    624                           (org-with-point-at (org-element-property :begin l)
    625 			    (org-attach-expand path)))))
    626 	     (and (not (file-remote-p file))
    627 		  (not (file-exists-p file))
    628 		  (list (org-element-property :begin l)
    629 			(format (if (org-element-lineage l '(link))
    630 				    "Link to non-existent image file %S \
    631 in description"
    632 				  "Link to non-existent local file %S")
    633                                 file)))))
    634 	  (_ nil))))))
    635 
    636 (defun org-lint-non-existent-setupfile-parameter (ast)
    637   (org-element-map ast 'keyword
    638     (lambda (k)
    639       (when (equal (org-element-property :key k) "SETUPFILE")
    640 	(let ((file (org-unbracket-string
    641 			"\"" "\""
    642 		      (org-element-property :value k))))
    643 	  (and (not (org-url-p file))
    644 	       (not (file-remote-p file))
    645 	       (not (file-exists-p file))
    646 	       (list (org-element-property :begin k)
    647 		     (format "Non-existent setup file %S" file))))))))
    648 
    649 (defun org-lint-wrong-include-link-parameter (ast)
    650   (org-element-map ast 'keyword
    651     (lambda (k)
    652       (when (equal (org-element-property :key k) "INCLUDE")
    653         (let* ((value (org-element-property :value k))
    654                (path
    655                 (and (string-match "^\\(\".+?\"\\|\\S-+\\)[ \t]*" value)
    656                      (save-match-data
    657                        (org-strip-quotes (match-string 1 value))))))
    658           (if (not path)
    659               (list (org-element-property :post-affiliated k)
    660                     "Missing location argument in INCLUDE keyword")
    661             (let* ((file (org-string-nw-p
    662                           (if (string-match "::\\(.*\\)\\'" path)
    663                               (substring path 0 (match-beginning 0))
    664                             path)))
    665                    (search (and (not (equal file path))
    666                                 (org-string-nw-p (match-string 1 path)))))
    667               (unless (org-url-p file)
    668                 (if (and file
    669                          (not (file-remote-p file))
    670                          (not (file-exists-p file)))
    671                     (list (org-element-property :post-affiliated k)
    672                           "Non-existent file argument in INCLUDE keyword")
    673                   (let* ((visiting (if file (find-buffer-visiting file)
    674                                      (current-buffer)))
    675                          (buffer (or visiting (find-file-noselect file)))
    676                          (org-link-search-must-match-exact-headline t))
    677                     (unwind-protect
    678                         (with-current-buffer buffer
    679                           (when (and search
    680                                      (not (ignore-errors
    681                                             (org-link-search search nil t))))
    682                             (list (org-element-property :post-affiliated k)
    683                                   (format
    684                                    "Invalid search part \"%s\" in INCLUDE keyword"
    685                                    search))))
    686                       (unless visiting (kill-buffer buffer)))))))))))))
    687 
    688 (defun org-lint-obsolete-include-markup (ast)
    689   (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
    690 			(regexp-opt
    691 			 '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
    692 			   "ODT" "ORG" "TEXINFO")
    693 			 t))))
    694     (org-element-map ast 'keyword
    695       (lambda (k)
    696 	(when (equal (org-element-property :key k) "INCLUDE")
    697 	  (let ((case-fold-search t)
    698 		(value (org-element-property :value k)))
    699 	    (when (string-match regexp value)
    700 	      (let ((markup (match-string-no-properties 1 value)))
    701 		(list (org-element-property :post-affiliated k)
    702 		      (format "Obsolete markup \"%s\" in INCLUDE keyword.  \
    703 Use \"export %s\" instead"
    704 			      markup
    705 			      markup))))))))))
    706 
    707 (defun org-lint-unknown-options-item (ast)
    708   (let ((allowed (delq nil
    709 		       (append
    710 			(mapcar (lambda (o) (nth 2 o)) org-export-options-alist)
    711 			(cl-mapcan
    712 			 (lambda (b)
    713 			   (mapcar (lambda (o) (nth 2 o))
    714 				   (org-export-backend-options b)))
    715 			 org-export-registered-backends))))
    716 	reports)
    717     (org-element-map ast 'keyword
    718       (lambda (k)
    719 	(when (string= (org-element-property :key k) "OPTIONS")
    720 	  (let ((value (org-element-property :value k))
    721 		(start 0))
    722 	    (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-+\\)?[ \t]*"
    723 				 value
    724 				 start)
    725 	      (setf start (match-end 0))
    726 	      (let ((item (match-string 1 value)))
    727 		(unless (member item allowed)
    728 		  (push (list (org-element-property :post-affiliated k)
    729 			      (format "Unknown OPTIONS item \"%s\"" item))
    730 			reports))
    731                 (unless (match-string 2 value)
    732                   (push (list (org-element-property :post-affiliated k)
    733                               (format "Missing value for option item %S" item))
    734                         reports))))))))
    735     reports))
    736 
    737 (defun org-lint-invalid-macro-argument-and-template (ast)
    738   (let* ((reports nil)
    739          (extract-placeholders
    740 	  (lambda (template)
    741 	    (let ((start 0)
    742 		  args)
    743 	      (while (string-match "\\$\\([1-9][0-9]*\\)" template start)
    744 	        (setf start (match-end 0))
    745 	        (push (string-to-number (match-string 1 template)) args))
    746 	      (sort (org-uniquify args) #'<))))
    747          (check-arity
    748           (lambda (arity macro)
    749             (let* ((name (org-element-property :key macro))
    750                    (pos (org-element-property :begin macro))
    751                    (args (org-element-property :args macro))
    752                    (l (length args)))
    753               (cond
    754                ((< l (1- (car arity)))
    755                 (push (list pos (format "Missing arguments in macro %S" name))
    756                       reports))
    757                ((< l (car arity))
    758                 (push (list pos (format "Missing argument in macro %S" name))
    759                       reports))
    760                ((> l (1+ (cdr arity)))
    761                 (push (let ((spurious-args (nthcdr (cdr arity) args)))
    762                         (list pos
    763                               (format "Spurious arguments in macro %S: %s"
    764                                       name
    765                                       (mapconcat #'org-trim spurious-args ", "))))
    766                       reports))
    767                ((> l (cdr arity))
    768                 (push (list pos
    769                             (format "Spurious argument in macro %S: %s"
    770                                     name
    771                                     (org-last args)))
    772                       reports))
    773                (t nil))))))
    774     ;; Check arguments for macro templates.
    775     (org-element-map ast 'keyword
    776       (lambda (k)
    777 	(when (string= (org-element-property :key k) "MACRO")
    778 	  (let* ((value (org-element-property :value k))
    779 		 (name (and (string-match "^\\S-+" value)
    780 			    (match-string 0 value)))
    781 		 (template (and name
    782 				(org-trim (substring value (match-end 0))))))
    783 	    (cond
    784 	     ((not name)
    785 	      (push (list (org-element-property :post-affiliated k)
    786 			  "Missing name in MACRO keyword")
    787 		    reports))
    788 	     ((not (org-string-nw-p template))
    789 	      (push (list (org-element-property :post-affiliated k)
    790 			  "Missing template in macro \"%s\"" name)
    791 		    reports))
    792 	     (t
    793 	      (unless (let ((args (funcall extract-placeholders template)))
    794 			(equal (number-sequence 1 (or (org-last args) 0)) args))
    795 		(push (list (org-element-property :post-affiliated k)
    796 			    (format "Unused placeholders in macro \"%s\""
    797 				    name))
    798 		      reports))))))))
    799     ;; Check arguments for macros.
    800     (org-macro-initialize-templates)
    801     (let ((templates (append
    802 		      (mapcar (lambda (m) (cons m "$1"))
    803 			      '("author" "date" "email" "title" "results"))
    804 		      org-macro-templates)))
    805       (org-element-map ast 'macro
    806 	(lambda (macro)
    807 	  (let* ((name (org-element-property :key macro))
    808 		 (template (cdr (assoc-string name templates t))))
    809             (pcase template
    810               (`nil
    811                (push (list (org-element-property :begin macro)
    812 			   (format "Undefined macro %S" name))
    813 		     reports))
    814               ((guard (string= name "keyword"))
    815                (funcall check-arity '(1 . 1) macro))
    816               ((guard (string= name "modification-time"))
    817                (funcall check-arity '(1 . 2) macro))
    818               ((guard (string= name "n"))
    819                (funcall check-arity '(0 . 2) macro))
    820               ((guard (string= name "property"))
    821                (funcall check-arity '(1 . 2) macro))
    822               ((guard (string= name "time"))
    823                (funcall check-arity '(1 . 1) macro))
    824               ((pred functionp))        ;ignore (eval ...) templates
    825               (_
    826                (let* ((arg-numbers (funcall extract-placeholders template))
    827                       (arity (if (null arg-numbers)
    828                                  '(0 . 0)
    829                                (let ((m (apply #'max arg-numbers)))
    830                                  (cons m m)))))
    831                  (funcall check-arity arity macro))))))))
    832     reports))
    833 
    834 (defun org-lint-undefined-footnote-reference (ast)
    835   (let ((definitions
    836           (org-element-map ast '(footnote-definition footnote-reference)
    837 	    (lambda (f)
    838               (and (or (eq 'footnote-definition (org-element-type f))
    839                        (eq 'inline (org-element-property :type f)))
    840                    (org-element-property :label f))))))
    841     (org-element-map ast 'footnote-reference
    842       (lambda (f)
    843 	(let ((label (org-element-property :label f)))
    844 	  (and (eq 'standard (org-element-property :type f))
    845 	       (not (member label definitions))
    846 	       (list (org-element-property :begin f)
    847 		     (format "Missing definition for footnote [%s]"
    848 			     label))))))))
    849 
    850 (defun org-lint-unreferenced-footnote-definition (ast)
    851   (let ((references (org-element-map ast 'footnote-reference
    852 		      (lambda (f) (org-element-property :label f)))))
    853     (org-element-map ast 'footnote-definition
    854       (lambda (f)
    855 	(let ((label (org-element-property :label f)))
    856 	  (and label
    857 	       (not (member label references))
    858 	       (list (org-element-property :post-affiliated f)
    859 		     (format "No reference for footnote definition [%s]"
    860 			     label))))))))
    861 
    862 (defun org-lint-colon-in-name (ast)
    863   (org-element-map ast org-element-all-elements
    864     (lambda (e)
    865       (let ((name (org-element-property :name e)))
    866 	(and name
    867 	     (string-match-p ":" name)
    868 	     (list (progn
    869 		     (goto-char (org-element-property :begin e))
    870 		     (re-search-forward
    871 		      (format "^[ \t]*#\\+\\w+: +%s *$" (regexp-quote name)))
    872 		     (match-beginning 0))
    873 		   (format
    874 		    "Name \"%s\" contains a colon; Babel cannot use it as input"
    875 		    name)))))))
    876 
    877 (defun org-lint-misplaced-planning-info (_)
    878   (let ((case-fold-search t)
    879 	reports)
    880     (while (re-search-forward org-planning-line-re nil t)
    881       (unless (memq (org-element-type (org-element-at-point))
    882 		    '(comment-block example-block export-block planning
    883 				    src-block verse-block))
    884 	(push (list (line-beginning-position) "Misplaced planning info line")
    885 	      reports)))
    886     reports))
    887 
    888 (defun org-lint-incomplete-drawer (_)
    889   (let (reports)
    890     (while (re-search-forward org-drawer-regexp nil t)
    891       (let ((name (org-trim (match-string-no-properties 0)))
    892 	    (element (org-element-at-point)))
    893 	(pcase (org-element-type element)
    894 	  (`drawer
    895 	   ;; Find drawer opening lines within non-empty drawers.
    896 	   (let ((end (org-element-property :contents-end element)))
    897 	     (when end
    898 	       (while (re-search-forward org-drawer-regexp end t)
    899 		 (let ((n (org-trim (match-string-no-properties 0))))
    900 		   (push (list (line-beginning-position)
    901 			       (format "Possible misleading drawer entry %S" n))
    902 			 reports))))
    903 	     (goto-char (org-element-property :end element))))
    904 	  (`property-drawer
    905 	   (goto-char (org-element-property :end element)))
    906 	  ((or `comment-block `example-block `export-block `src-block
    907 	       `verse-block)
    908 	   nil)
    909 	  (_
    910 	   ;; Find drawer opening lines outside of any drawer.
    911 	   (push (list (line-beginning-position)
    912 		       (format "Possible incomplete drawer %S" name))
    913 		 reports)))))
    914     reports))
    915 
    916 (defun org-lint-indented-diary-sexp (_)
    917   (let (reports)
    918     (while (re-search-forward "^[ \t]+%%(" nil t)
    919       (unless (memq (org-element-type (org-element-at-point))
    920 		    '(comment-block diary-sexp example-block export-block
    921 				    src-block verse-block))
    922 	(push (list (line-beginning-position) "Possible indented diary-sexp")
    923 	      reports)))
    924     reports))
    925 
    926 (defun org-lint-invalid-block (_)
    927   (let ((case-fold-search t)
    928 	(regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
    929 	reports)
    930     (while (re-search-forward regexp nil t)
    931       (let ((name (org-trim (buffer-substring-no-properties
    932 			     (line-beginning-position) (line-end-position)))))
    933 	(cond
    934 	 ((and (string-prefix-p "END" (match-string 1) t)
    935 	       (not (eolp)))
    936 	  (push (list (line-beginning-position)
    937 		      (format "Invalid block closing line \"%s\"" name))
    938 		reports))
    939 	 ((not (memq (org-element-type (org-element-at-point))
    940 		     '(center-block comment-block dynamic-block example-block
    941 				    export-block quote-block special-block
    942 				    src-block verse-block)))
    943 	  (push (list (line-beginning-position)
    944 		      (format "Possible incomplete block \"%s\""
    945 			      name))
    946 		reports)))))
    947     reports))
    948 
    949 (defun org-lint-invalid-keyword-syntax (_)
    950   (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
    951 	(exception-re
    952 	 (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
    953 		 (regexp-opt org-element-dual-keywords)))
    954 	reports)
    955     (while (re-search-forward regexp nil t)
    956       (let ((name (match-string-no-properties 1)))
    957 	(unless (or (string-prefix-p "BEGIN" name t)
    958 		    (string-prefix-p "END" name t)
    959 		    (save-excursion
    960 		      (beginning-of-line)
    961 		      (let ((case-fold-search t)) (looking-at exception-re))))
    962 	  (push (list (match-beginning 0)
    963 		      (format "Possible missing colon in keyword \"%s\"" name))
    964 		reports))))
    965     reports))
    966 
    967 (defun org-lint-extraneous-element-in-footnote-section (ast)
    968   (org-element-map ast 'headline
    969     (lambda (h)
    970       (and (org-element-property :footnote-section-p h)
    971 	   (org-element-map (org-element-contents h)
    972 	       (cl-remove-if
    973 		(lambda (e)
    974 		  (memq e '(comment comment-block footnote-definition
    975 				    property-drawer section)))
    976 		org-element-all-elements)
    977 	     (lambda (e)
    978 	       (not (and (eq (org-element-type e) 'headline)
    979 			 (org-element-property :commentedp e))))
    980 	     nil t '(footnote-definition property-drawer))
    981 	   (list (org-element-property :begin h)
    982 		 "Extraneous elements in footnote section are not exported")))))
    983 
    984 (defun org-lint-quote-section (ast)
    985   (org-element-map ast '(headline inlinetask)
    986     (lambda (h)
    987       (let ((title (org-element-property :raw-value h)))
    988 	(and (or (string-prefix-p "QUOTE " title)
    989 		 (string-prefix-p (concat org-comment-string " QUOTE ") title))
    990 	     (list (org-element-property :begin h)
    991 		   "Deprecated QUOTE section"))))))
    992 
    993 (defun org-lint-file-application (ast)
    994   (org-element-map ast 'link
    995     (lambda (l)
    996       (let ((app (org-element-property :application l)))
    997 	(and app
    998 	     (list (org-element-property :begin l)
    999 		   (format "Deprecated \"file+%s\" link type" app)))))))
   1000 
   1001 (defun org-lint-percent-encoding-link-escape (ast)
   1002   (org-element-map ast 'link
   1003     (lambda (l)
   1004       (when (eq 'bracket (org-element-property :format l))
   1005 	(let* ((uri (org-element-property :path l))
   1006 	       (start 0)
   1007 	       (obsolete-flag
   1008 		(catch :obsolete
   1009 		  (while (string-match "%\\(..\\)?" uri start)
   1010 		    (setq start (match-end 0))
   1011 		    (unless (member (match-string 1 uri) '("25" "5B" "5D" "20"))
   1012 		      (throw :obsolete nil)))
   1013 		  (string-match-p "%" uri))))
   1014 	  (when obsolete-flag
   1015 	    (list (org-element-property :begin l)
   1016 		  "Link escaped with obsolete percent-encoding syntax")))))))
   1017 
   1018 (defun org-lint-wrong-header-argument (ast)
   1019   (let* ((reports)
   1020 	 (verify
   1021 	  (lambda (datum language headers)
   1022 	    (let ((allowed
   1023 		   ;; If LANGUAGE is specified, restrict allowed
   1024 		   ;; headers to both LANGUAGE-specific and default
   1025 		   ;; ones.  Otherwise, accept headers from any loaded
   1026 		   ;; language.
   1027 		   (append
   1028 		    org-babel-header-arg-names
   1029 		    (cl-mapcan
   1030 		     (lambda (l)
   1031 		       (let ((v (intern (format "org-babel-header-args:%s" l))))
   1032 			 (and (boundp v) (mapcar #'car (symbol-value v)))))
   1033 		     (if language (list language)
   1034 		       (mapcar #'car org-babel-load-languages))))))
   1035 	      (dolist (header headers)
   1036 		(let ((h (symbol-name (car header)))
   1037 		      (p (or (org-element-property :post-affiliated datum)
   1038 			     (org-element-property :begin datum))))
   1039 		  (cond
   1040 		   ((not (string-prefix-p ":" h))
   1041 		    (push
   1042 		     (list p
   1043 			   (format "Missing colon in header argument \"%s\"" h))
   1044 		     reports))
   1045 		   ((assoc-string (substring h 1) allowed))
   1046 		   (t (push (list p (format "Unknown header argument \"%s\"" h))
   1047 			    reports)))))))))
   1048     (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword
   1049 				      node-property src-block)
   1050       (lambda (datum)
   1051 	(pcase (org-element-type datum)
   1052 	  ((or `babel-call `inline-babel-call)
   1053 	   (funcall verify
   1054 		    datum
   1055 		    nil
   1056 		    (cl-mapcan #'org-babel-parse-header-arguments
   1057 			       (list
   1058 				(org-element-property :inside-header datum)
   1059 				(org-element-property :end-header datum)))))
   1060 	  (`inline-src-block
   1061 	   (funcall verify
   1062 		    datum
   1063 		    (org-element-property :language datum)
   1064 		    (org-babel-parse-header-arguments
   1065 		     (org-element-property :parameters datum))))
   1066 	  (`keyword
   1067 	   (when (string= (org-element-property :key datum) "PROPERTY")
   1068 	     (let ((value (org-element-property :value datum)))
   1069 	       (when (or (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+ *"
   1070 				       value)
   1071                          (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)? *"
   1072 				       value))
   1073 		 (funcall verify
   1074 			  datum
   1075 			  (match-string 1 value)
   1076 			  (org-babel-parse-header-arguments
   1077 			   (substring value (match-end 0))))))))
   1078 	  (`node-property
   1079 	   (let ((key (org-element-property :key datum)))
   1080 	     (when (let ((case-fold-search t))
   1081 		     (or (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+"
   1082 				       key)
   1083                          (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?"
   1084 				       key)))
   1085 	       (funcall verify
   1086 			datum
   1087 			(match-string 1 key)
   1088 			(org-babel-parse-header-arguments
   1089 			 (org-element-property :value datum))))))
   1090 	  (`src-block
   1091 	   (funcall verify
   1092 		    datum
   1093 		    (org-element-property :language datum)
   1094 		    (cl-mapcan #'org-babel-parse-header-arguments
   1095 			       (cons (org-element-property :parameters datum)
   1096 				     (org-element-property :header datum))))))))
   1097     reports))
   1098 
   1099 (defun org-lint-wrong-header-value (ast)
   1100   (let (reports)
   1101     (org-element-map ast
   1102 	'(babel-call inline-babel-call inline-src-block src-block)
   1103       (lambda (datum)
   1104 	(let* ((type (org-element-type datum))
   1105 	       (language (org-element-property :language datum))
   1106 	       (allowed-header-values
   1107 		(append (and language
   1108 			     (let ((v (intern (concat "org-babel-header-args:"
   1109 						      language))))
   1110 			       (and (boundp v) (symbol-value v))))
   1111 			org-babel-common-header-args-w-values))
   1112 	       (datum-header-values
   1113 		(org-babel-parse-header-arguments
   1114 		 (org-trim
   1115 		  (pcase type
   1116 		    (`src-block
   1117 		     (mapconcat
   1118 		      #'identity
   1119 		      (cons (org-element-property :parameters datum)
   1120 			    (org-element-property :header datum))
   1121 		      " "))
   1122 		    (`inline-src-block
   1123 		     (or (org-element-property :parameters datum) ""))
   1124 		    (_
   1125 		     (concat
   1126 		      (org-element-property :inside-header datum)
   1127 		      " "
   1128 		      (org-element-property :end-header datum))))))))
   1129 	  (dolist (header datum-header-values)
   1130 	    (let ((allowed-values
   1131 		   (cdr (assoc-string (substring (symbol-name (car header)) 1)
   1132 				      allowed-header-values))))
   1133 	      (unless (memq allowed-values '(:any nil))
   1134 		(let ((values (cdr header))
   1135 		      groups-alist)
   1136 		  (dolist (v (if (stringp values) (split-string values)
   1137 			       (list values)))
   1138 		    (let ((valid-value nil))
   1139 		      (catch 'exit
   1140 			(dolist (group allowed-values)
   1141 			  (cond
   1142 			   ((not (funcall
   1143 				  (if (stringp v) #'assoc-string #'assoc)
   1144 				  v group))
   1145 			    (when (memq :any group)
   1146 			      (setf valid-value t)
   1147 			      (push (cons group v) groups-alist)))
   1148 			   ((assq group groups-alist)
   1149 			    (push
   1150 			     (list
   1151 			      (or (org-element-property :post-affiliated datum)
   1152 				  (org-element-property :begin datum))
   1153 			      (format
   1154 			       "Forbidden combination in header \"%s\": %s, %s"
   1155 			       (car header)
   1156 			       (cdr (assq group groups-alist))
   1157 			       v))
   1158 			     reports)
   1159 			    (throw 'exit nil))
   1160 			   (t (push (cons group v) groups-alist)
   1161 			      (setf valid-value t))))
   1162 			(unless valid-value
   1163 			  (push
   1164 			   (list
   1165 			    (or (org-element-property :post-affiliated datum)
   1166 				(org-element-property :begin datum))
   1167 			    (format "Unknown value \"%s\" for header \"%s\""
   1168 				    v
   1169 				    (car header)))
   1170 			   reports))))))))))))
   1171     reports))
   1172 
   1173 (defun org-lint-spurious-colons (ast)
   1174   (org-element-map ast '(headline inlinetask)
   1175     (lambda (h)
   1176       (when (member "" (org-element-property :tags h))
   1177 	(list (org-element-property :begin h)
   1178 	      "Tags contain a spurious colon")))))
   1179 
   1180 (defun org-lint-non-existent-bibliography (ast)
   1181   (org-element-map ast 'keyword
   1182     (lambda (k)
   1183       (when (equal "BIBLIOGRAPHY" (org-element-property :key k))
   1184         (let ((file (org-strip-quotes (org-element-property :value k))))
   1185           (and (not (file-remote-p file))
   1186 	       (not (file-exists-p file))
   1187 	       (list (org-element-property :begin k)
   1188 		     (format "Non-existent bibliography %S" file))))))))
   1189 
   1190 (defun org-lint-missing-print-bibliography (ast)
   1191   (and (org-element-map ast 'citation #'identity nil t)
   1192        (not (org-element-map ast 'keyword
   1193               (lambda (k)
   1194                 (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key k)))
   1195               nil t))
   1196        (list
   1197         (list (point-max) "Possibly missing \"PRINT_BIBLIOGRAPHY\" keyword"))))
   1198 
   1199 (defun org-lint-invalid-cite-export-declaration (ast)
   1200   (org-element-map ast 'keyword
   1201     (lambda (k)
   1202       (when (equal "CITE_EXPORT" (org-element-property :key k))
   1203         (let ((value (org-element-property :value k))
   1204               (source (org-element-property :begin k)))
   1205           (if (equal value "")
   1206               (list source "Missing export processor name")
   1207             (condition-case _
   1208                 (pcase (org-cite-read-processor-declaration value)
   1209                   (`(,(and (pred symbolp) name)
   1210                      ,(pred string-or-null-p)
   1211                      ,(pred string-or-null-p))
   1212                    (unless (org-cite-get-processor name)
   1213                      (list source "Unknown cite export processor %S" name)))
   1214                   (_
   1215                    (list source "Invalid cite export processor declaration")))
   1216               (error
   1217                (list source "Invalid cite export processor declaration")))))))))
   1218 
   1219 (defun org-lint-incomplete-citation (ast)
   1220   (org-element-map ast 'plain-text
   1221     (lambda (text)
   1222       (and (string-match-p org-element-citation-prefix-re text)
   1223            ;; XXX: The code below signals the error at the beginning
   1224            ;; of the paragraph containing the faulty object.  It is
   1225            ;; not very accurate but may be enough for now.
   1226            (list (org-element-property :contents-begin
   1227                                        (org-element-property :parent text))
   1228                  "Possibly incomplete citation markup")))))
   1229 
   1230 
   1231 ;;; Checkers declaration
   1232 
   1233 (org-lint-add-checker 'duplicate-custom-id
   1234   "Report duplicates CUSTOM_ID properties"
   1235   #'org-lint-duplicate-custom-id
   1236   :categories '(link))
   1237 
   1238 (org-lint-add-checker 'duplicate-name
   1239   "Report duplicate NAME values"
   1240   #'org-lint-duplicate-name
   1241   :categories '(babel 'link))
   1242 
   1243 (org-lint-add-checker 'duplicate-target
   1244   "Report duplicate targets"
   1245   #'org-lint-duplicate-target
   1246   :categories '(link))
   1247 
   1248 (org-lint-add-checker 'duplicate-footnote-definition
   1249   "Report duplicate footnote definitions"
   1250   #'org-lint-duplicate-footnote-definition
   1251   :categories '(footnote))
   1252 
   1253 (org-lint-add-checker 'orphaned-affiliated-keywords
   1254   "Report orphaned affiliated keywords"
   1255   #'org-lint-orphaned-affiliated-keywords
   1256   :trust 'low)
   1257 
   1258 (org-lint-add-checker 'obsolete-affiliated-keywords
   1259   "Report obsolete affiliated keywords"
   1260   #'org-lint-obsolete-affiliated-keywords
   1261   :categories '(obsolete))
   1262 
   1263 (org-lint-add-checker 'deprecated-export-blocks
   1264   "Report deprecated export block syntax"
   1265   #'org-lint-deprecated-export-blocks
   1266   :trust 'low :categories '(obsolete export))
   1267 
   1268 (org-lint-add-checker 'deprecated-header-syntax
   1269   "Report deprecated Babel header syntax"
   1270   #'org-lint-deprecated-header-syntax
   1271   :trust 'low :categories '(obsolete babel))
   1272 
   1273 (org-lint-add-checker 'missing-language-in-src-block
   1274   "Report missing language in source blocks"
   1275   #'org-lint-missing-language-in-src-block
   1276   :categories '(babel))
   1277 
   1278 (org-lint-add-checker 'missing-backend-in-export-block
   1279   "Report missing back-end in export blocks"
   1280   #'org-lint-missing-backend-in-export-block
   1281   :categories '(export))
   1282 
   1283 (org-lint-add-checker 'invalid-babel-call-block
   1284   "Report invalid Babel call blocks"
   1285   #'org-lint-invalid-babel-call-block
   1286   :categories '(babel))
   1287 
   1288 (org-lint-add-checker 'colon-in-name
   1289   "Report NAME values with a colon"
   1290   #'org-lint-colon-in-name
   1291   :categories '(babel))
   1292 
   1293 (org-lint-add-checker 'wrong-header-argument
   1294   "Report wrong babel headers"
   1295   #'org-lint-wrong-header-argument
   1296   :categories '(babel))
   1297 
   1298 (org-lint-add-checker 'wrong-header-value
   1299   "Report invalid value in babel headers"
   1300   #'org-lint-wrong-header-value
   1301   :categories '(babel) :trust 'low)
   1302 
   1303 (org-lint-add-checker 'deprecated-category-setup
   1304   "Report misuse of CATEGORY keyword"
   1305   #'org-lint-deprecated-category-setup
   1306   :categories '(obsolete))
   1307 
   1308 (org-lint-add-checker 'invalid-coderef-link
   1309   "Report \"coderef\" links with unknown destination"
   1310   #'org-lint-invalid-coderef-link
   1311   :categories '(link))
   1312 
   1313 (org-lint-add-checker 'invalid-custom-id-link
   1314   "Report \"custom-id\" links with unknown destination"
   1315   #'org-lint-invalid-custom-id-link
   1316   :categories '(link))
   1317 
   1318 (org-lint-add-checker 'invalid-fuzzy-link
   1319   "Report \"fuzzy\" links with unknown destination"
   1320   #'org-lint-invalid-fuzzy-link
   1321   :categories '(link))
   1322 
   1323 (org-lint-add-checker 'invalid-id-link
   1324   "Report \"id\" links with unknown destination"
   1325   #'org-lint-invalid-id-link
   1326   :categories '(link))
   1327 
   1328 (org-lint-add-checker 'link-to-local-file
   1329   "Report links to non-existent local files"
   1330   #'org-lint-link-to-local-file
   1331   :categories '(link) :trust 'low)
   1332 
   1333 (org-lint-add-checker 'non-existent-setupfile-parameter
   1334   "Report SETUPFILE keywords with non-existent file parameter"
   1335   #'org-lint-non-existent-setupfile-parameter
   1336   :trust 'low)
   1337 
   1338 (org-lint-add-checker 'wrong-include-link-parameter
   1339   "Report INCLUDE keywords with misleading link parameter"
   1340   #'org-lint-wrong-include-link-parameter
   1341   :categories '(export) :trust 'low)
   1342 
   1343 (org-lint-add-checker 'obsolete-include-markup
   1344   "Report obsolete markup in INCLUDE keyword"
   1345   #'org-lint-obsolete-include-markup
   1346   :categories '(obsolete export) :trust 'low)
   1347 
   1348 (org-lint-add-checker 'unknown-options-item
   1349   "Report unknown items in OPTIONS keyword"
   1350   #'org-lint-unknown-options-item
   1351   :categories '(export) :trust 'low)
   1352 
   1353 (org-lint-add-checker 'invalid-macro-argument-and-template
   1354   "Report spurious macro arguments or invalid macro templates"
   1355   #'org-lint-invalid-macro-argument-and-template
   1356   :categories '(export) :trust 'low)
   1357 
   1358 (org-lint-add-checker 'special-property-in-properties-drawer
   1359   "Report special properties in properties drawers"
   1360   #'org-lint-special-property-in-properties-drawer
   1361   :categories '(properties))
   1362 
   1363 (org-lint-add-checker 'obsolete-properties-drawer
   1364   "Report obsolete syntax for properties drawers"
   1365   #'org-lint-obsolete-properties-drawer
   1366   :categories '(obsolete properties))
   1367 
   1368 (org-lint-add-checker 'invalid-effort-property
   1369   "Report invalid duration in EFFORT property"
   1370   #'org-lint-invalid-effort-property
   1371   :categories '(properties))
   1372 
   1373 (org-lint-add-checker 'undefined-footnote-reference
   1374   "Report missing definition for footnote references"
   1375   #'org-lint-undefined-footnote-reference
   1376   :categories '(footnote))
   1377 
   1378 (org-lint-add-checker 'unreferenced-footnote-definition
   1379   "Report missing reference for footnote definitions"
   1380   #'org-lint-unreferenced-footnote-definition
   1381   :categories '(footnote))
   1382 
   1383 (org-lint-add-checker 'extraneous-element-in-footnote-section
   1384   "Report non-footnote definitions in footnote section"
   1385   #'org-lint-extraneous-element-in-footnote-section
   1386   :categories '(footnote))
   1387 
   1388 (org-lint-add-checker 'invalid-keyword-syntax
   1389   "Report probable invalid keywords"
   1390   #'org-lint-invalid-keyword-syntax
   1391   :trust 'low)
   1392 
   1393 (org-lint-add-checker 'invalid-block
   1394   "Report invalid blocks"
   1395   #'org-lint-invalid-block
   1396   :trust 'low)
   1397 
   1398 (org-lint-add-checker 'misplaced-planning-info
   1399   "Report misplaced planning info line"
   1400   #'org-lint-misplaced-planning-info
   1401   :trust 'low)
   1402 
   1403 (org-lint-add-checker 'incomplete-drawer
   1404   "Report probable incomplete drawers"
   1405   #'org-lint-incomplete-drawer
   1406   :trust 'low)
   1407 
   1408 (org-lint-add-checker 'indented-diary-sexp
   1409   "Report probable indented diary-sexps"
   1410   #'org-lint-indented-diary-sexp
   1411   :trust 'low)
   1412 
   1413 (org-lint-add-checker 'quote-section
   1414   "Report obsolete QUOTE section"
   1415   #'org-lint-quote-section
   1416   :categories '(obsolete) :trust 'low)
   1417 
   1418 (org-lint-add-checker 'file-application
   1419   "Report obsolete \"file+application\" link"
   1420   #'org-lint-file-application
   1421   :categories '(link obsolete))
   1422 
   1423 (org-lint-add-checker 'percent-encoding-link-escape
   1424   "Report obsolete escape syntax in links"
   1425   #'org-lint-percent-encoding-link-escape
   1426   :categories '(link obsolete) :trust 'low)
   1427 
   1428 (org-lint-add-checker 'spurious-colons
   1429   "Report spurious colons in tags"
   1430   #'org-lint-spurious-colons
   1431   :categories '(tags))
   1432 
   1433 (org-lint-add-checker 'non-existent-bibliography
   1434   "Report invalid bibliography file"
   1435   #'org-lint-non-existent-bibliography
   1436   :categories '(cite))
   1437 
   1438 (org-lint-add-checker 'missing-print-bibliography
   1439   "Report missing \"print_bibliography\" keyword"
   1440   #'org-lint-missing-print-bibliography
   1441   :categories '(cite))
   1442 
   1443 (org-lint-add-checker 'invalid-cite-export-declaration
   1444   "Report invalid value for \"cite_export\" keyword"
   1445   #'org-lint-invalid-cite-export-declaration
   1446   :categories '(cite))
   1447 
   1448 (org-lint-add-checker 'incomplete-citation
   1449   "Report incomplete citation object"
   1450   #'org-lint-incomplete-citation
   1451   :categories '(cite) :trust 'low)
   1452 
   1453 (provide 'org-lint)
   1454 
   1455 ;; Local variables:
   1456 ;; generated-autoload-file: "org-loaddefs.el"
   1457 ;; End:
   1458 
   1459 ;;; org-lint.el ends here