;;; org-lint.el --- Linting for Org documents        -*- lexical-binding: t; -*-

;; Copyright (C) 2015-2024 Free Software Foundation, Inc.

;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
;; Keywords: outlines, hypermedia, calendar, text

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; This library implements linting for Org syntax.  The process is
;; started by calling `org-lint' command, which see.

;; New checkers are added by `org-lint-add-checker' function.
;; Internally, all checks are listed in `org-lint--checkers'.

;; Results are displayed in a special "*Org Lint*" buffer with
;; a dedicated major mode, derived from `tabulated-list-mode'.
;; In addition to the usual key-bindings inherited from it, "C-j" and
;; "TAB" display problematic line reported under point whereas "RET"
;; jumps to it.  Also, "h" hides all reports similar to the current
;; one.  Additionally, "i" removes them from subsequent reports.

;; Checks currently implemented report the following:

;; - duplicates CUSTOM_ID properties,
;; - duplicate NAME values,
;; - duplicate targets,
;; - duplicate footnote definitions,
;; - orphaned affiliated keywords,
;; - obsolete affiliated keywords,
;; - deprecated export block syntax,
;; - deprecated Babel header syntax,
;; - missing language in source blocks,
;; - missing backend in export blocks,
;; - invalid Babel call blocks,
;; - NAME values with a colon,
;; - wrong babel headers,
;; - invalid value in babel headers,
;; - misuse of CATEGORY keyword,
;; - "coderef" links with unknown destination,
;; - "custom-id" links with unknown destination,
;; - "fuzzy" links with unknown destination,
;; - "id" links with unknown destination,
;; - links to non-existent local files,
;; - SETUPFILE keywords with non-existent file parameter,
;; - INCLUDE keywords with misleading link parameter,
;; - obsolete markup in INCLUDE keyword,
;; - unknown items in OPTIONS keyword,
;; - spurious macro arguments or invalid macro templates,
;; - special properties in properties drawers,
;; - obsolete syntax for properties drawers,
;; - invalid duration in EFFORT property,
;; - invalid ID property with a double colon,
;; - missing definition for footnote references,
;; - missing reference for footnote definitions,
;; - non-footnote definitions in footnote section,
;; - probable invalid keywords,
;; - invalid blocks,
;; - mismatched repeaters in planning info line,
;; - misplaced planning info line,
;; - probable incomplete drawers,
;; - probable indented diary-sexps,
;; - obsolete QUOTE section,
;; - obsolete "file+application" link,
;; - obsolete escape syntax in links,
;; - spurious colons in tags,
;; - invalid bibliography file,
;; - missing "print_bibliography" keyword,
;; - invalid value for "cite_export" keyword,
;; - incomplete citation object.

\f
;;; Code:

(require 'org-macs)
(org-assert-version)

(require 'cl-lib)
(require 'ob)
(require 'oc)
(require 'ol)
(require 'org-attach)
(require 'org-macro)
(require 'org-fold)
(require 'ox)
(require 'seq)

\f
;;; Checkers structure

(cl-defstruct (org-lint-checker (:copier nil))
  name summary function trust categories)

(defvar org-lint--checkers nil
  "List of all available checkers.
This list is populated by `org-lint-add-checker' function.")

;;;###autoload
(defun org-lint-add-checker (name summary fun &rest props)
  "Add a new checker for linter.

NAME is a unique check identifier, as a non-nil symbol.  SUMMARY
is a short description of the check, as a string.

The check is done calling the function FUN with one mandatory
argument, the parse tree describing the current Org buffer.  Such
function calls are wrapped within a `save-excursion' and point is
always at `point-min'.  Its return value has to be an
alist (POSITION MESSAGE) where POSITION refer to the buffer
position of the error, as an integer, and MESSAGE is a one-line
string describing the error.

Optional argument PROPS provides additional information about the
checker.  Currently, two properties are supported:

  `:categories'

     Categories relative to the check, as a list of symbol.  They
     are used for filtering when calling `org-lint'.  Checkers
     not explicitly associated to a category are collected in the
     `default' one.

  `:trust'

    The trust level one can have in the check.  It is either
    `low' or `high', depending on the heuristics implemented and
    the nature of the check.  This has an indicative value only
    and is displayed along reports."
  (declare (indent 1))
  ;; Sanity checks.
  (pcase name
    (`nil (error "Name field is mandatory for checkers"))
    ((pred symbolp) nil)
    (_ (error "Invalid type for name field")))
  (unless (functionp fun)
    (error "Checker field is expected to be a valid function"))
  ;; Install checker in `org-lint--checkers'; uniquify by name.
  (setq org-lint--checkers
        (cons (apply #'make-org-lint-checker
                     :name name
                     :summary summary
                     :function fun
                     props)
              (seq-remove (lambda (c) (eq name (org-lint-checker-name c)))
                          org-lint--checkers))))

;;;###autoload
(defun org-lint-remove-checker (name &rest names)
  "Remove checker(s) from linter.
NAME is the unique check identifier, as a non-nil symbol.  NAMES
are additional check identifiers to be removed."
  (let ((removelist (cons name names)))
    (setq org-lint--checkers
          (seq-remove (lambda (c) (memq (org-lint-checker-name c) removelist))
                      org-lint--checkers))))

\f
;;; Reports UI

;; next-error support
(defvar org-lint--next-error-top-of-buffer t
  "Is the next error the one at the first line of the buffer?

Unlike compilation and grep buffers the first line of the org lint
report refers to an error.  This needs special handling.")

(defun org-lint--next-error-function (n &optional reset)
  "Find and display the next line error in the report.
N is an integer specifying by how many errors to move.
RESET is a boolean which, if non-nil, says to go back to the beginning
of the errors before moving.

This function is the local support for the next-error machinery."
  (when reset
    (setq org-lint--next-error-top-of-buffer t)
    (goto-char (point-min)))
  (when org-lint--next-error-top-of-buffer
    (setq
     org-lint--next-error-top-of-buffer nil
     n (1- n))) ; In compilation buffers, point starts before the
                ; first error, so stepping forward one brings you to
                ; the first error.  Here the first error is on the
                ; first line so adjust the count accordingly.
  (forward-line n)
  (org-lint--show-source))

;; Report mode

(defvar org-lint--report-mode-map
  (let ((map (make-sparse-keymap)))
    (set-keymap-parent map tabulated-list-mode-map)
    (define-key map (kbd "RET") 'org-lint--jump-to-source)
    (define-key map (kbd "TAB") 'org-lint--show-source)
    (define-key map (kbd "C-j") 'org-lint--show-source)
    (define-key map (kbd "h") 'org-lint--hide-checker)
    (define-key map (kbd "i") 'org-lint--ignore-checker)
    map)
  "Local keymap for `org-lint--report-mode' buffers.")

(define-derived-mode org-lint--report-mode tabulated-list-mode "OrgLint"
  "Major mode used to display reports emitted during linting.
\\{org-lint--report-mode-map}"
  ;; next-error support.
  (make-local-variable 'org-lint--next-error-top-of-buffer)
  (setq
   next-error-function 'org-lint--next-error-function
   next-error-last-buffer (current-buffer))

  (setf tabulated-list-format
	`[("Line" 6
	   (lambda (a b)
	     (< (string-to-number (aref (cadr a) 0))
		(string-to-number (aref (cadr b) 0))))
	   :right-align t)
	  ("Trust" 5 t)
	  ("Warning" 0 t)])
  (tabulated-list-init-header))

(defun org-lint--generate-reports (buffer checkers)
  "Generate linting report for BUFFER.

CHECKERS is the list of checkers used.

Return an alist (ID [LINE TRUST DESCRIPTION CHECKER]), suitable
for `tabulated-list-printer'."
  (with-current-buffer buffer
    (save-excursion
      (goto-char (point-min))
      (let ((ast (org-element-parse-buffer nil nil 'defer))
	    (id 0)
	    (last-line 1)
	    (last-pos 1))
	;; Insert unique ID for each report.  Replace buffer positions
	;; with line numbers.
	(mapcar
	 (lambda (report)
	   (list
	    (cl-incf id)
	    (apply #'vector
		   (cons
		    (progn
		      (goto-char (car report))
		      (forward-line 0)
		      (prog1 (propertize
                              (number-to-string
			       (cl-incf last-line
				        (count-lines last-pos (point))))
                              'org-lint-marker (car report))
			(setf last-pos (point))))
		    (cdr report)))))
	 ;; Insert trust level in generated reports.  Also sort them
	 ;; by buffer position in order to optimize lines computation.
	 (sort (cl-mapcan
		(lambda (c)
		  (let ((trust (symbol-name (org-lint-checker-trust c))))
		    (mapcar
		     (lambda (report)
		       (list (copy-marker (car report)) trust (nth 1 report) c))
		     (save-excursion
		       (funcall (org-lint-checker-function c)
			        ast)))))
		checkers)
	       #'car-less-than-car))))))

(defvar-local org-lint--source-buffer nil
  "Source buffer associated to current report buffer.")

(defvar-local org-lint--local-checkers nil
  "List of checkers used to build current report.")

(defun org-lint--refresh-reports ()
  (setq tabulated-list-entries
	(org-lint--generate-reports org-lint--source-buffer
				    org-lint--local-checkers))
  (tabulated-list-print))

(defun org-lint--current-line ()
  "Return current report line, as a number."
  (string-to-number (aref (tabulated-list-get-entry) 0)))

(defun org-lint--current-marker ()
  "Return current report marker."
  (get-text-property 0 'org-lint-marker (aref (tabulated-list-get-entry) 0)))

(defun org-lint--current-checker (&optional entry)
  "Return current report checker.
When optional argument ENTRY is non-nil, use this entry instead
of current one."
  (aref (if entry (nth 1 entry) (tabulated-list-get-entry)) 3))

(defun org-lint--display-reports (source checkers)
  "Display linting reports for buffer SOURCE.
CHECKERS is the list of checkers used."
  (let ((buffer (get-buffer-create "*Org Lint*")))
    (with-current-buffer buffer
      (org-lint--report-mode)
      (setf org-lint--source-buffer source)
      (setf org-lint--local-checkers checkers)
      (org-lint--refresh-reports)
      (add-hook 'tabulated-list-revert-hook #'org-lint--refresh-reports nil t))
    (pop-to-buffer buffer)))

(defun org-lint--jump-to-source ()
  "Move to source line that generated the report at point."
  (interactive)
  (let ((mk (org-lint--current-marker)))
    (switch-to-buffer-other-window org-lint--source-buffer)
    (unless (<= (point-min) mk (point-max)) (widen))
    (goto-char mk)
    (org-fold-show-set-visibility 'local)
    (recenter)))

(defun org-lint--show-source ()
  "Show source line that generated the report at point."
  (interactive)
  (let ((buffer (current-buffer)))
    (org-lint--jump-to-source)
    (switch-to-buffer-other-window buffer)))

(defun org-lint--hide-checker ()
  "Hide all reports from checker that generated the report at point."
  (interactive)
  (let ((c (org-lint--current-checker)))
    (setf tabulated-list-entries
	  (cl-remove-if (lambda (e) (equal c (org-lint--current-checker e)))
			tabulated-list-entries))
    (tabulated-list-print)))

(defun org-lint--ignore-checker ()
  "Ignore all reports from checker that generated the report at point.
Checker will also be ignored in all subsequent reports."
  (interactive)
  (setf org-lint--local-checkers
	(remove (org-lint--current-checker) org-lint--local-checkers))
  (org-lint--hide-checker))

\f
;;; Main function

;;;###autoload
(defun org-lint (&optional arg)
  "Check current Org buffer for syntax mistakes.

By default, run all checkers.  With a `\\[universal-argument]' prefix ARG, \
select one
category of checkers only.  With a `\\[universal-argument] \
\\[universal-argument]' prefix, run one precise
checker by its name.

ARG can also be a list of checker names, as symbols, to run."
  (interactive "P")
  (unless (derived-mode-p 'org-mode) (user-error "Not in an Org buffer"))
  (when (called-interactively-p 'any)
    (message "Org linting process starting..."))
  (let ((checkers
	 (pcase arg
	   (`nil org-lint--checkers)
	   (`(4)
	    (let ((category
		   (completing-read
		    "Checker category: "
		    (mapcar #'org-lint-checker-categories org-lint--checkers)
		    nil t)))
	      (cl-remove-if-not
	       (lambda (c)
		 (assoc-string category (org-lint-checker-categories c)))
	       org-lint--checkers)))
	   (`(16)
	    (list
	     (let ((name (completing-read
			  "Checker name: "
			  (mapcar #'org-lint-checker-name org-lint--checkers)
			  nil t)))
	       (catch 'exit
		 (dolist (c org-lint--checkers)
		   (when (string= (org-lint-checker-name c) name)
		     (throw 'exit c)))))))
	   ((pred consp)
	    (cl-remove-if-not (lambda (c) (memq (org-lint-checker-name c) arg))
			      org-lint--checkers))
	   (_ (user-error "Invalid argument `%S' for `org-lint'" arg)))))
    (if (not (called-interactively-p 'any))
	(org-lint--generate-reports (current-buffer) checkers)
      (org-lint--display-reports (current-buffer) checkers)
      (message "Org linting process completed"))))

\f
;;; Checker functions

(defun org-lint--collect-duplicates
    (ast type extract-key extract-position build-message)
  "Helper function to collect duplicates in parse tree AST.

EXTRACT-KEY is a function extracting key.  It is called with
a single argument: the element or object.  Comparison is done
with `equal'.

EXTRACT-POSITION is a function returning position for the report.
It is called with two arguments, the object or element, and the
key.

BUILD-MESSAGE is a function creating the report message.  It is
called with one argument, the key used for comparison."
  (let* (keys
	 originals
	 reports
	 (make-report
	  (lambda (position value)
	    (push (list position (funcall build-message value)) reports))))
    (org-element-map ast type
      (lambda (datum)
	(let ((key (funcall extract-key datum)))
	  (cond
	   ((not key))
	   ((assoc key keys) (cl-pushnew (assoc key keys) originals)
	    (funcall make-report (funcall extract-position datum key) key))
	   (t (push (cons key (funcall extract-position datum key)) keys))))))
    (dolist (e originals reports) (funcall make-report (cdr e) (car e)))))

(defun org-lint-misplaced-heading (ast)
  "Check for accidentally misplaced heading lines.
Example:
** Heading 1
** Heading 2** Oops heading 3
** Heading 4"
  (org-with-point-at ast
    (goto-char (point-min))
    (let (result)
      ;; Heuristics for 2+ level heading not at bol.
      (while (re-search-forward (rx (not (any "*\n\r ,")) ;; Not a bol; not escaped ,** heading; not " *** words"
                                    "*" (1+ "*") " ") nil t)
        ;; Limit false-positive rate by only complaining about
        ;; ** Heading** Heading and
        ;; ** Oops heading
        ;; Paragraph** Oops heading
        (when (org-element-type-p
               (org-element-at-point)
               '(paragraph headline))
          (push (list (match-beginning 0) "Possibly misplaced heading line") result)))
      result)))

(defun org-lint-duplicate-custom-id (ast)
  (org-lint--collect-duplicates
   ast
   'node-property
   (lambda (property)
     (and (org-string-equal-ignore-case
           "CUSTOM_ID" (org-element-property :key property))
	  (org-element-property :value property)))
   (lambda (property _) (org-element-begin property))
   (lambda (key) (format "Duplicate CUSTOM_ID property \"%s\"" key))))

(defun org-lint-duplicate-name (ast)
  (org-lint--collect-duplicates
   ast
   org-element-all-elements
   (lambda (datum) (org-element-property :name datum))
   (lambda (datum name)
     (goto-char (org-element-begin datum))
     (re-search-forward
      (format "^[ \t]*#\\+[A-Za-z]+:[ \t]*%s[ \t]*$" (regexp-quote name)))
     (match-beginning 0))
   (lambda (key) (format "Duplicate NAME \"%s\"" key))))

(defun org-lint-duplicate-target (ast)
  (org-lint--collect-duplicates
   ast
   'target
   (lambda (target) (split-string (org-element-property :value target)))
   (lambda (target _) (org-element-begin target))
   (lambda (key)
     (format "Duplicate target <<%s>>" (mapconcat #'identity key " ")))))

(defun org-lint-duplicate-footnote-definition (ast)
  (org-lint--collect-duplicates
   ast
   'footnote-definition
   (lambda (definition)  (org-element-property :label definition))
   (lambda (definition _) (org-element-post-affiliated definition))
   (lambda (key) (format "Duplicate footnote definition \"%s\"" key))))

(defun org-lint-orphaned-affiliated-keywords (ast)
  ;; Ignore orphan RESULTS keywords, which could be generated from
  ;; a source block returning no value.
  (let ((keywords (cl-set-difference org-element-affiliated-keywords
				     '("RESULT" "RESULTS")
				     :test #'equal)))
    (org-element-map ast 'keyword
      (lambda (k)
	(let ((key (org-element-property :key k)))
	  (and (or (let ((case-fold-search t))
		     (string-match-p "\\`ATTR_[-_A-Za-z0-9]+\\'" key))
		   (member key keywords))
	       (list (org-element-post-affiliated k)
		     (format "Orphaned affiliated keyword: \"%s\"" key))))))))

(defun org-lint-regular-keyword-before-affiliated (ast)
  (org-element-map ast 'keyword
    (lambda (keyword)
      (when (= (org-element-post-blank keyword) 0)
        (let ((next-element (org-with-point-at (org-element-end keyword)
                              (org-element-at-point))))
          (when (< (org-element-begin next-element) (org-element-post-affiliated next-element))
            ;; A keyword followed without blank lines by an element with affiliated keywords.
            ;; The keyword may be confused with affiliated keywords.
            (list (org-element-begin keyword)
                  (format "Independent keyword %s may be confused with affiliated keywords below"
                          (org-element-property :key keyword)))))))))

(defun org-lint-obsolete-affiliated-keywords (_)
  (let ((regexp (format "^[ \t]*#\\+%s:"
			(regexp-opt '("DATA" "LABEL" "RESNAME" "SOURCE"
				      "SRCNAME" "TBLNAME" "RESULT" "HEADERS")
				    t)))
	reports)
    (while (re-search-forward regexp nil t)
      (let ((key (upcase (match-string-no-properties 1))))
	(when (< (point)
		 (org-element-post-affiliated (org-element-at-point)))
	  (push
	   (list (line-beginning-position)
		 (format
		  "Obsolete affiliated keyword: \"%s\".  Use \"%s\" instead"
		  key
		  (pcase key
		    ("HEADERS" "HEADER")
		    ("RESULT" "RESULTS")
		    (_ "NAME"))))
	   reports))))
    reports))

(defun org-lint-deprecated-export-blocks (ast)
  (let ((deprecated '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
		      "ODT" "ORG" "TEXINFO")))
    (org-element-map ast 'special-block
      (lambda (b)
	(let ((type (org-element-property :type b)))
	  (when (member-ignore-case type deprecated)
	    (list
	     (org-element-post-affiliated b)
	     (format
	      "Deprecated syntax for export block.  Use \"BEGIN_EXPORT %s\" \
instead"
	      type))))))))

(defun org-lint-deprecated-header-syntax (ast)
  (let* ((deprecated-babel-properties
	  ;; DIR is also used for attachments.
	  (delete "dir"
		  (mapcar (lambda (arg) (downcase (symbol-name (car arg))))
			  org-babel-common-header-args-w-values)))
	 (deprecated-re
	  (format "\\`%s[ \t]" (regexp-opt deprecated-babel-properties t))))
    (org-element-map ast '(keyword node-property)
      (lambda (datum)
	(let ((key (org-element-property :key datum)))
	  (pcase (org-element-type datum)
	    (`keyword
	     (let ((value (org-element-property :value datum)))
	       (and (string= key "PROPERTY")
		    (string-match deprecated-re value)
		    (list (org-element-begin datum)
			  (format "Deprecated syntax for \"%s\".  \
Use header-args instead"
				  (match-string-no-properties 1 value))))))
	    (`node-property
	     (and (member-ignore-case key deprecated-babel-properties)
		  (list
		   (org-element-begin datum)
		   (format "Deprecated syntax for \"%s\".  \
Use :header-args: instead"
			   key))))))))))

(defun org-lint-missing-language-in-src-block (ast)
  (org-element-map ast 'src-block
    (lambda (b)
      (unless (org-element-property :language b)
	(list (org-element-post-affiliated b)
	      "Missing language in source block")))))

(defun org-lint-suspicious-language-in-src-block (ast)
  (org-element-map ast 'src-block
    (lambda (b)
      (when-let* ((lang (org-element-property :language b)))
        (unless (or (functionp (intern (format "org-babel-execute:%s" lang)))
                    ;; No babel backend, but there is corresponding
                    ;; major mode.
                    (fboundp (org-src-get-lang-mode lang)))
	  (list (org-element-property :post-affiliated b)
	        (format "Unknown source block language: '%s'" lang)))))))

(defun org-lint-missing-backend-in-export-block (ast)
  (org-element-map ast 'export-block
    (lambda (b)
      (unless (org-element-property :type b)
	(list (org-element-post-affiliated b)
	      "Missing backend in export block")))))

(defun org-lint-invalid-babel-call-block (ast)
  (org-element-map ast 'babel-call
    (lambda (b)
      (cond
       ((not (org-element-property :call b))
	(list (org-element-post-affiliated b)
	      "Invalid syntax in babel call block"))
       ((let ((h (org-element-property :end-header b)))
	  (and h (string-match-p "\\`\\[.*\\]\\'" h)))
	(list
	 (org-element-post-affiliated b)
	 "Babel call's end header must not be wrapped within brackets"))))))

(defun org-lint-deprecated-category-setup (ast)
  (org-element-map ast 'keyword
    (let (category-flag)
      (lambda (k)
	(cond
	 ((not (string= (org-element-property :key k) "CATEGORY")) nil)
	 (category-flag
	  (list (org-element-post-affiliated k)
		"Spurious CATEGORY keyword.  Set :CATEGORY: property instead"))
	 (t (setf category-flag t) nil))))))

(defun org-lint-invalid-coderef-link (ast)
  (let ((info (list :parse-tree ast)))
    (org-element-map ast 'link
      (lambda (link)
	(let ((ref (org-element-property :path link)))
	  (and (equal (org-element-property :type link) "coderef")
	       (not (ignore-errors (org-export-resolve-coderef ref info)))
	       (list (org-element-begin link)
		     (format "Unknown coderef \"%s\"" ref))))))))

(defun org-lint-invalid-custom-id-link (ast)
  (let ((info (list :parse-tree ast)))
    (org-element-map ast 'link
      (lambda (link)
	(and (equal (org-element-property :type link) "custom-id")
	     (not (ignore-errors (org-export-resolve-id-link link info)))
	     (list (org-element-begin link)
		   (format "Unknown custom ID \"%s\""
			   (org-element-property :path link))))))))

(defun org-lint-invalid-fuzzy-link (ast)
  (let ((info (list :parse-tree ast)))
    (org-element-map ast 'link
      (lambda (link)
	(and (equal (org-element-property :type link) "fuzzy")
	     (not (ignore-errors (org-export-resolve-fuzzy-link link info)))
	     (list (org-element-begin link)
		   (format "Unknown fuzzy location \"%s\""
			   (let ((path (org-element-property :path link)))
			     (if (string-prefix-p "*" path)
				 (substring path 1)
			       path)))))))))

(defun org-lint-invalid-id-link (ast)
  (let ((id-locations-updated nil))
    (org-element-map ast 'link
      (lambda (link)
        (let ((id (org-element-property :path link)))
	  (and (equal (org-element-property :type link) "id")
               (progn
                 (unless id-locations-updated
                   (org-id-update-id-locations nil t)
                   (setq id-locations-updated t))
                 t)
               ;; The locations are up-to-date with file changes after
               ;; the call to `org-id-update-id-locations'.  We do not
               ;; need to double-check if recorded ID is still present
               ;; in the file.
	       (not (org-id-find-id-file id))
	       (list (org-element-begin link)
		     (format "Unknown ID \"%s\"" id))))))))

(defun org-lint-confusing-brackets (ast)
  (org-element-map ast 'link
    (lambda (link)
      (org-with-wide-buffer
       (when (eq (char-after (org-element-end link)) ?\])
         (list (org-element-begin link)
	       (format "Trailing ']' after link end")))))))

(defun org-lint-brackets-inside-description (ast)
  (org-element-map ast 'link
    (lambda (link)
      (when (org-element-contents-begin link)
        (org-with-point-at link
          (goto-char (org-element-contents-begin link))
          (let ((count 0))
            (while (re-search-forward (rx (or ?\] ?\[)) (org-element-contents-end link) t)
              (if (equal (match-string 0) "[") (cl-incf count) (cl-decf count)))
            (when (> count 0)
              (list (org-element-begin link)
	            (format "No closing ']' matches '[' in link description: %s"
                            (buffer-substring-no-properties
                             (org-element-contents-begin link)
                             (org-element-contents-end link)))))))))))

(defun org-lint-special-property-in-properties-drawer (ast)
  (org-element-map ast 'node-property
    (lambda (p)
      (let ((key (org-element-property :key p)))
	(and (member-ignore-case key org-special-properties)
	     (list (org-element-begin p)
		   (format
		    "Special property \"%s\" found in a properties drawer"
		    key)))))))

(defun org-lint-obsolete-properties-drawer (ast)
  (org-element-map ast 'drawer
    (lambda (d)
      (when (equal (org-element-property :drawer-name d) "PROPERTIES")
	(let ((headline? (org-element-lineage d 'headline))
	      (before
	       (mapcar #'org-element-type
		       (assq d (reverse (org-element-contents
					 (org-element-parent d)))))))
	  (list (org-element-post-affiliated d)
		(if (or (and headline? (member before '(nil (planning))))
			(and (null headline?) (member before '(nil (comment)))))
		    "Incorrect contents for PROPERTIES drawer"
		  "Incorrect location for PROPERTIES drawer")))))))

(defun org-lint-invalid-effort-property (ast)
  (org-element-map ast 'node-property
    (lambda (p)
      (when (equal "EFFORT" (org-element-property :key p))
	(let ((value (org-element-property :value p)))
	  (and (org-string-nw-p value)
	       (not (org-duration-p value))
	       (list (org-element-begin p)
		     (format "Invalid effort duration format: %S" value))))))))

(defun org-lint-invalid-id-property (ast)
  (org-element-map ast 'node-property
    (lambda (p)
      (when (equal "ID" (org-element-property :key p))
	(let ((value (org-element-property :value p)))
	  (and (org-string-nw-p value)
               (string-match-p "::" value)
	       (list (org-element-begin p)
		     (format "IDs should not include \"::\": %S" value))))))))

(defun org-lint-link-to-local-file (ast)
  (org-element-map ast 'link
    (lambda (l)
      (let ((type (org-element-property :type l)))
	(pcase type
	  ((or "attachment" "file")
	   (let* ((path (org-element-property :path l))
		  (file (if (string= type "file")
			    path
                          (org-with-point-at (org-element-begin l)
			    (org-attach-expand path)))))
             (setq file (substitute-env-in-file-name file))
	     (and (not (file-remote-p file))
		  (not (file-exists-p file))
		  (list (org-element-begin l)
			(format (if (org-element-lineage l 'link)
				    "Link to non-existent image file %S \
in description"
				  "Link to non-existent local file %S")
                                file)))))
	  (_ nil))))))

(defun org-lint-non-existent-setupfile-parameter (ast)
  (org-element-map ast 'keyword
    (lambda (k)
      (when (equal (org-element-property :key k) "SETUPFILE")
	(let ((file (org-unbracket-string
			"\"" "\""
		      (org-element-property :value k))))
	  (and (not (org-url-p file))
	       (not (file-remote-p file))
	       (not (file-exists-p file))
	       (list (org-element-begin k)
		     (format "Non-existent setup file %S" file))))))))

(defun org-lint-wrong-include-link-parameter (ast)
  (org-element-map ast 'keyword
    (lambda (k)
      (when (equal (org-element-property :key k) "INCLUDE")
        (let* ((value (org-element-property :value k))
               (path
                (and (string-match "^\\(\".+?\"\\|\\S-+\\)[ \t]*" value)
                     (save-match-data
                       (org-strip-quotes (match-string 1 value))))))
          (if (not path)
              (list (org-element-post-affiliated k)
                    "Missing location argument in INCLUDE keyword")
            (let* ((file (org-string-nw-p
                          (if (string-match "::\\(.*\\)\\'" path)
                              (substring path 0 (match-beginning 0))
                            path)))
                   (search (and (not (equal file path))
                                (org-string-nw-p (match-string 1 path)))))
              (unless (org-url-p file)
                (if (and file
                         (not (file-remote-p file))
                         (not (file-exists-p file)))
                    (list (org-element-post-affiliated k)
                          "Non-existent file argument in INCLUDE keyword")
                  (let* ((visiting (if file (find-buffer-visiting file)
                                     (current-buffer)))
                         (buffer (or visiting (find-file-noselect file)))
                         (org-link-search-must-match-exact-headline t))
                    (unwind-protect
                        (with-current-buffer buffer
                          (org-with-wide-buffer
                           (when (and search
                                      (not (ignore-errors
                                           (org-link-search search nil t))))
                             (list (org-element-post-affiliated k)
                                   (format
                                    "Invalid search part \"%s\" in INCLUDE keyword"
                                    search)))))
                      (unless visiting (kill-buffer buffer)))))))))))))

(defun org-lint-obsolete-include-markup (ast)
  (let ((regexp (format "\\`\\(?:\".+\"\\|\\S-+\\)[ \t]+%s"
			(regexp-opt
			 '("ASCII" "BEAMER" "HTML" "LATEX" "MAN" "MARKDOWN" "MD"
			   "ODT" "ORG" "TEXINFO")
			 t))))
    (org-element-map ast 'keyword
      (lambda (k)
	(when (equal (org-element-property :key k) "INCLUDE")
	  (let ((case-fold-search t)
		(value (org-element-property :value k)))
	    (when (string-match regexp value)
	      (let ((markup (match-string-no-properties 1 value)))
		(list (org-element-post-affiliated k)
		      (format "Obsolete markup \"%s\" in INCLUDE keyword.  \
Use \"export %s\" instead"
			      markup
			      markup))))))))))

(defun org-lint-unknown-options-item (ast)
  (let ((allowed (delq nil
		       (append
			(mapcar (lambda (o) (nth 2 o)) org-export-options-alist)
			(cl-mapcan
			 (lambda (b)
			   (mapcar (lambda (o) (nth 2 o))
				   (org-export-backend-options b)))
			 org-export-registered-backends))))
	reports)
    (org-element-map ast 'keyword
      (lambda (k)
	(when (string= (org-element-property :key k) "OPTIONS")
	  (let ((value (org-element-property :value k))
		(start 0))
	    (while (string-match "\\(.+?\\):\\((.*?)\\|\\S-+\\)?[ \t]*"
				 value
				 start)
	      (setf start (match-end 0))
	      (let ((item (match-string 1 value)))
		(unless (member item allowed)
		  (push (list (org-element-post-affiliated k)
			      (format "Unknown OPTIONS item \"%s\"" item))
			reports))
                (unless (match-string 2 value)
                  (push (list (org-element-post-affiliated k)
                              (format "Missing value for option item %S" item))
                        reports))))))))
    reports))

(defun org-lint-export-option-keywords (ast)
  "Check for options keyword properties without EXPORT in AST."
  (require 'ox)
  (let (options reports common-options options-alist)
    (dolist (opt org-export-options-alist)
      (when (stringp (nth 1 opt))
        (cl-pushnew (nth 1 opt) common-options :test #'equal)))
    (dolist (backend org-export-registered-backends)
      (dolist (opt (org-export-backend-options backend))
        (when (stringp (nth 1 opt))
          (cl-pushnew (or (org-export-backend-name backend) 'anonymous)
                      (alist-get (nth 1 opt) options-alist nil nil #'equal))
	  (cl-pushnew (nth 1 opt) options :test #'equal))))
    (setq options-alist (nreverse options-alist))
    (org-element-map ast 'node-property
      (lambda (node)
        (let ((prop (org-element-property :key node)))
          (when (and (or (member prop options) (member prop common-options))
                     (not (member prop org-default-properties)))
            (push (list (org-element-post-affiliated node)
                        (format "Potentially misspelled %sexport option \"%s\"%s.  Consider \"EXPORT_%s\"."
                                (when (member prop common-options)
                                  "global ")
                                prop
                                (if-let* ((backends
                                           (and (not (member prop common-options))
                                                (cdr (assoc-string prop options-alist)))))
                                    (format
                                     " in %S export %s"
                                     (if (= 1 (length backends)) (car backends) backends)
                                     (if (> (length backends) 1) "backends" "backend"))
                                  "")
                                prop))
                  reports)))))
    reports))

(defun org-lint-invalid-macro-argument-and-template (ast)
  (let* ((reports nil)
         (extract-placeholders
	  (lambda (template)
	    (let ((start 0)
		  args)
	      (while (string-match "\\$\\([1-9][0-9]*\\)" template start)
	        (setf start (match-end 0))
	        (push (string-to-number (match-string 1 template)) args))
	      (sort (org-uniquify args) #'<))))
         (check-arity
          (lambda (arity macro)
            (let* ((name (org-element-property :key macro))
                   (pos (org-element-begin macro))
                   (args (org-element-property :args macro))
                   (l (length args)))
              (cond
               ((< l (1- (car arity)))
                (push (list pos (format "Missing arguments in macro %S" name))
                      reports))
               ((< l (car arity))
                (push (list pos (format "Missing argument in macro %S" name))
                      reports))
               ((> l (1+ (cdr arity)))
                (push (let ((spurious-args (nthcdr (cdr arity) args)))
                        (list pos
                              (format "Spurious arguments in macro %S: %s"
                                      name
                                      (mapconcat #'org-trim spurious-args ", "))))
                      reports))
               ((> l (cdr arity))
                (push (list pos
                            (format "Spurious argument in macro %S: %s"
                                    name
                                    (org-last args)))
                      reports))
               (t nil))))))
    ;; Check arguments for macro templates.
    (org-element-map ast 'keyword
      (lambda (k)
	(when (string= (org-element-property :key k) "MACRO")
	  (let* ((value (org-element-property :value k))
		 (name (and (string-match "^\\S-+" value)
			    (match-string 0 value)))
		 (template (and name
				(org-trim (substring value (match-end 0))))))
	    (cond
	     ((not name)
	      (push (list (org-element-post-affiliated k)
			  "Missing name in MACRO keyword")
		    reports))
	     ((not (org-string-nw-p template))
	      (push (list (org-element-post-affiliated k)
			  "Missing template in macro \"%s\"" name)
		    reports))
	     (t
	      (unless (let ((args (funcall extract-placeholders template)))
			(equal (number-sequence 1 (or (org-last args) 0)) args))
		(push (list (org-element-post-affiliated k)
			    (format "Unused placeholders in macro \"%s\""
				    name))
		      reports))))))))
    ;; Check arguments for macros.
    (org-macro-initialize-templates)
    (let ((templates (append
		      (mapcar (lambda (m) (cons m "$1"))
			      '("author" "date" "email" "title" "results"))
		      org-macro-templates)))
      (org-element-map ast 'macro
	(lambda (macro)
	  (let* ((name (org-element-property :key macro))
		 (template (cdr (assoc-string name templates t))))
            (pcase template
              (`nil
               (push (list (org-element-begin macro)
			   (format "Undefined macro %S" name))
		     reports))
              ((guard (string= name "keyword"))
               (funcall check-arity '(1 . 1) macro))
              ((guard (string= name "modification-time"))
               (funcall check-arity '(1 . 2) macro))
              ((guard (string= name "n"))
               (funcall check-arity '(0 . 2) macro))
              ((guard (string= name "property"))
               (funcall check-arity '(1 . 2) macro))
              ((guard (string= name "time"))
               (funcall check-arity '(1 . 1) macro))
              ((pred functionp))        ;ignore (eval ...) templates
              (_
               (let* ((arg-numbers (funcall extract-placeholders template))
                      (arity (if (null arg-numbers)
                                 '(0 . 0)
                               (let ((m (apply #'max arg-numbers)))
                                 (cons m m)))))
                 (funcall check-arity arity macro))))))))
    reports))

(defun org-lint-undefined-footnote-reference (ast)
  (let ((definitions
         (org-element-map ast '(footnote-definition footnote-reference)
	   (lambda (f)
             (and (or (org-element-type-p f 'footnote-definition)
                      (eq 'inline (org-element-property :type f)))
                  (org-element-property :label f))))))
    (org-element-map ast 'footnote-reference
      (lambda (f)
	(let ((label (org-element-property :label f)))
	  (and (eq 'standard (org-element-property :type f))
	       (not (member label definitions))
	       (list (org-element-begin f)
		     (format "Missing definition for footnote [%s]"
			     label))))))))

(defun org-lint-unreferenced-footnote-definition (ast)
  (let ((references (org-element-map ast 'footnote-reference
		      (lambda (f) (org-element-property :label f)))))
    (org-element-map ast 'footnote-definition
      (lambda (f)
	(let ((label (org-element-property :label f)))
	  (and label
	       (not (member label references))
	       (list (org-element-post-affiliated f)
		     (format "No reference for footnote definition [%s]"
			     label))))))))

(defun org-lint-mismatched-planning-repeaters (ast)
  (org-element-map ast 'planning
    (lambda (e)
      (let* ((scheduled (org-element-property :scheduled e))
             (deadline (org-element-property :deadline e))
             (scheduled-repeater-type (org-element-property
                                       :repeater-type scheduled))
             (deadline-repeater-type (org-element-property
                                      :repeater-type deadline))
             (scheduled-repeater-value (org-element-property
                                        :repeater-value scheduled))
             (deadline-repeater-value (org-element-property
                                       :repeater-value deadline)))
        (when (and scheduled deadline
                   (memq scheduled-repeater-type '(cumulate catch-up))
                   (memq deadline-repeater-type '(cumulate catch-up))
                   (> scheduled-repeater-value 0)
                   (> deadline-repeater-value 0)
                   (not
                    (and
                     (eq scheduled-repeater-type deadline-repeater-type)
                     (eq (org-element-property :repeater-unit scheduled)
                         (org-element-property :repeater-unit deadline))
                     (eql scheduled-repeater-value deadline-repeater-value))))
          (list
           (org-element-property :begin e)
           "Different repeaters in SCHEDULED and DEADLINE timestamps."))))))

(defun org-lint-misplaced-planning-info (_)
  (let ((case-fold-search t)
	reports)
    (while (re-search-forward org-planning-line-re nil t)
      (unless (org-element-type-p
               (org-element-at-point)
	       '(comment-block example-block export-block planning
			       src-block verse-block))
	(push (list (line-beginning-position) "Misplaced planning info line")
	      reports)))
    reports))

(defun org-lint-incomplete-drawer (_)
  (let (reports)
    (while (re-search-forward org-drawer-regexp nil t)
      (let ((name (org-trim (match-string-no-properties 0)))
	    (element (org-element-at-point)))
	(pcase (org-element-type element)
	  (`drawer
	   ;; Find drawer opening lines within non-empty drawers.
	   (let ((end (org-element-contents-end element)))
	     (when end
	       (while (re-search-forward org-drawer-regexp end t)
		 (let ((n (org-trim (match-string-no-properties 0))))
		   (push (list (line-beginning-position)
			       (format "Possible misleading drawer entry %S" n))
			 reports))))
	     (goto-char (org-element-end element))))
	  (`property-drawer
	   (goto-char (org-element-end element)))
	  ((or `comment-block `example-block `export-block `src-block
	       `verse-block)
	   nil)
	  (_
	   ;; Find drawer opening lines outside of any drawer.
	   (push (list (line-beginning-position)
		       (format "Possible incomplete drawer %S" name))
		 reports)))))
    reports))

(defun org-lint-indented-diary-sexp (_)
  (let (reports)
    (while (re-search-forward "^[ \t]+%%(" nil t)
      (unless (org-element-type-p
               (org-element-at-point)
	       '(comment-block diary-sexp example-block export-block
			       src-block verse-block))
	(push (list (line-beginning-position) "Possible indented diary-sexp")
	      reports)))
    reports))

(defun org-lint-invalid-block (_)
  (let ((case-fold-search t)
	(regexp "^[ \t]*#\\+\\(BEGIN\\|END\\)\\(?::\\|_[^[:space:]]*\\)?[ \t]*")
	reports)
    (while (re-search-forward regexp nil t)
      (let ((name (org-trim (buffer-substring-no-properties
			     (line-beginning-position) (line-end-position)))))
	(cond
	 ((and (string-prefix-p "END" (match-string 1) t)
	       (not (eolp)))
	  (push (list (line-beginning-position)
		      (format "Invalid block closing line \"%s\"" name))
		reports))
	 ((not (org-element-type-p
              (org-element-at-point)
	      '(center-block comment-block dynamic-block example-block
			     export-block quote-block special-block
			     src-block verse-block)))
	  (push (list (line-beginning-position)
		      (format "Possible incomplete block \"%s\""
			      name))
		reports)))))
    reports))

(defun org-lint-invalid-keyword-syntax (_)
  (let ((regexp "^[ \t]*#\\+\\([^[:space:]:]*\\)\\(?: \\|$\\)")
	(exception-re
	 (format "[ \t]*#\\+%s\\(\\[.*\\]\\)?:\\(?: \\|$\\)"
		 (regexp-opt org-element-dual-keywords)))
	reports)
    (while (re-search-forward regexp nil t)
      (let ((name (match-string-no-properties 1)))
	(unless (or (string-prefix-p "BEGIN" name t)
		    (string-prefix-p "END" name t)
		    (save-excursion
		      (forward-line 0)
		      (let ((case-fold-search t)) (looking-at exception-re))))
	  (push (list (match-beginning 0)
		      (format "Possible missing colon in keyword \"%s\"" name))
		reports))))
    reports))

(defun org-lint-invalid-image-alignment (ast)
  (apply
   #'nconc
   (org-element-map ast 'paragraph
     (lambda (p)
       (let ((center-re ":center[[:space:]]+\\(\\S-+\\)")
             (align-re ":align[[:space:]]+\\(\\S-+\\)")
             (keyword-string
              (car-safe (org-element-property :attr_org p)))
             reports)
         (when keyword-string
           (when (and (string-match align-re keyword-string)
                      (not (member (match-string 1 keyword-string)
                                   '("left" "center" "right"))))
             (push
              (list (org-element-begin p)
                    (format
                     "\"%s\" not a supported value for #+ATTR_ORG keyword attribute \":align\"."
                     (match-string 1 keyword-string)))
              reports))
           (when (and (string-match center-re keyword-string)
                      (not (equal (match-string 1 keyword-string) "t")))
             (push
              (list (org-element-begin p)
                    (format
                     "\"%s\" not a supported value for #+ATTR_ORG keyword attribute \":center\"."
                     (match-string 1 keyword-string)))
              reports)))
         reports)))))

(defun org-lint-extraneous-element-in-footnote-section (ast)
  (org-element-map ast 'headline
    (lambda (h)
      (and (org-element-property :footnote-section-p h)
	   (org-element-map (org-element-contents h)
	       (cl-remove-if
		(lambda (e)
		  (memq e '(comment comment-block footnote-definition
				    property-drawer section)))
		org-element-all-elements)
	     (lambda (e)
	       (not (and (org-element-type-p e 'headline)
		       (org-element-property :commentedp e))))
	     nil t '(footnote-definition property-drawer))
	   (list (org-element-begin h)
		 "Extraneous elements in footnote section are not exported")))))

(defun org-lint-quote-section (ast)
  (org-element-map ast '(headline inlinetask)
    (lambda (h)
      (let ((title (org-element-property :raw-value h)))
	(and (or (string-prefix-p "QUOTE " title)
		 (string-prefix-p (concat org-comment-string " QUOTE ") title))
	     (list (org-element-begin h)
		   "Deprecated QUOTE section"))))))

(defun org-lint-file-application (ast)
  (org-element-map ast 'link
    (lambda (l)
      (let ((app (org-element-property :application l)))
	(and app
	     (list (org-element-begin l)
		   (format "Deprecated \"file+%s\" link type" app)))))))

(defun org-lint-percent-encoding-link-escape (ast)
  (org-element-map ast 'link
    (lambda (l)
      (when (eq 'bracket (org-element-property :format l))
	(let* ((uri (org-element-property :path l))
	       (start 0)
	       (obsolete-flag
		(catch :obsolete
		  (while (string-match "%\\(..\\)?" uri start)
		    (setq start (match-end 0))
		    (unless (member (match-string 1 uri) '("25" "5B" "5D" "20"))
		      (throw :obsolete nil)))
		  (string-match-p "%" uri))))
	  (when obsolete-flag
	    (list (org-element-begin l)
		  "Link escaped with obsolete percent-encoding syntax")))))))

(defun org-lint-wrong-header-argument (ast)
  (let* ((reports)
	 (verify
	  (lambda (datum language headers)
	    (let ((allowed
		   ;; If LANGUAGE is specified, restrict allowed
		   ;; headers to both LANGUAGE-specific and default
		   ;; ones.  Otherwise, accept headers from any loaded
		   ;; language.
		   (append
		    org-babel-header-arg-names
		    (cl-mapcan
		     (lambda (l)
		       (let ((v (intern (format "org-babel-header-args:%s" l))))
			 (and (boundp v) (mapcar #'car (symbol-value v)))))
		     (if language (list language)
		       (mapcar #'car org-babel-load-languages))))))
	      (dolist (header headers)
		(let ((h (symbol-name (car header)))
		      (p (or (org-element-post-affiliated datum)
			     (org-element-begin datum))))
		  (cond
		   ((not (string-prefix-p ":" h))
		    (push
		     (list p
			   (format "Missing colon in header argument \"%s\"" h))
		     reports))
		   ((assoc-string (substring h 1) allowed))
		   (t (push (list p (format "Unknown header argument \"%s\"" h))
			    reports)))))))))
    (org-element-map ast '(babel-call inline-babel-call inline-src-block keyword
				      node-property src-block)
      (lambda (datum)
	(pcase (org-element-type datum)
	  ((or `babel-call `inline-babel-call)
	   (funcall verify
		    datum
		    nil
		    (cl-mapcan #'org-babel-parse-header-arguments
			       (list
				(org-element-property :inside-header datum)
				(org-element-property :end-header datum)))))
	  (`inline-src-block
	   (funcall verify
		    datum
		    (org-element-property :language datum)
		    (org-babel-parse-header-arguments
		     (org-element-property :parameters datum))))
	  (`keyword
	   (when (string= (org-element-property :key datum) "PROPERTY")
	     (let ((value (org-element-property :value datum)))
	       (when (or (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)?\\+ *"
				       value)
                         (string-match "\\`header-args\\(?::\\(\\S-+\\)\\)? *"
				       value))
		 (funcall verify
			  datum
			  (match-string 1 value)
			  (org-babel-parse-header-arguments
			   (substring value (match-end 0))))))))
	  (`node-property
	   (let ((key (org-element-property :key datum)))
	     (when (let ((case-fold-search t))
		     (or (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?\\+"
				       key)
                         (string-match "\\`HEADER-ARGS\\(?::\\(\\S-+\\)\\)?"
				       key)))
	       (funcall verify
			datum
			(match-string 1 key)
			(org-babel-parse-header-arguments
			 (org-element-property :value datum))))))
	  (`src-block
	   (funcall verify
		    datum
		    (org-element-property :language datum)
		    (cl-mapcan #'org-babel-parse-header-arguments
			       (cons (org-element-property :parameters datum)
				     (org-element-property :header datum))))))))
    reports))

(defun org-lint-empty-header-argument (ast)
  (let* (reports)
    (org-element-map ast '(babel-call inline-babel-call inline-src-block src-block)
      (lambda (datum)
        (let ((headers
	       (pcase (org-element-type datum)
	         ((or `babel-call `inline-babel-call)
		  (cl-mapcan
                   (lambda (header) (org-babel-parse-header-arguments header 'no-eval))
		   (list
		    (org-element-property :inside-header datum)
		    (org-element-property :end-header datum))))
	         (`inline-src-block
		  (org-babel-parse-header-arguments
		   (org-element-property :parameters datum)
                   'no-eval))
	         (`src-block
		  (cl-mapcan
                   (lambda (header) (org-babel-parse-header-arguments header 'no-eval))
		   (cons (org-element-property :parameters datum)
			 (org-element-property :header datum)))))))
          (dolist (header headers)
            (when (not (cdr header))
              (push
	       (list
                (or (org-element-post-affiliated datum)
		    (org-element-begin datum))
		(format "Empty value in header argument \"%s\"" (symbol-name (car header))))
	       reports))))))
    reports))

(defun org-lint-wrong-header-value (ast)
  (let (reports)
    (org-element-map ast
	'(babel-call inline-babel-call inline-src-block src-block)
      (lambda (datum)
	(let* ((type (org-element-type datum))
	       (language (org-element-property :language datum))
	       (allowed-header-values
		(append (and language
			     (let ((v (intern (concat "org-babel-header-args:"
						      language))))
			       (and (boundp v) (symbol-value v))))
			org-babel-common-header-args-w-values))
	       (datum-header-values
		(org-babel-parse-header-arguments
		 (org-trim
		  (pcase type
		    (`src-block
		     (mapconcat
		      #'identity
		      (cons (org-element-property :parameters datum)
			    (org-element-property :header datum))
		      " "))
		    (`inline-src-block
		     (or (org-element-property :parameters datum) ""))
		    (_
		     (concat
		      (org-element-property :inside-header datum)
		      " "
		      (org-element-property :end-header datum))))))))
	  (dolist (header datum-header-values)
	    (let ((allowed-values
		   (cdr (assoc-string (substring (symbol-name (car header)) 1)
				      allowed-header-values))))
	      (unless (memq allowed-values '(:any nil))
		(let ((values (cdr header))
		      groups-alist)
		  (dolist (v (if (stringp values) (split-string values)
			       (list values)))
		    (let ((valid-value nil))
		      (catch 'exit
			(dolist (group allowed-values)
			  (cond
			   ((not (funcall
				  (if (stringp v) #'assoc-string #'assoc)
				  v group))
			    (when (memq :any group)
			      (setf valid-value t)
			      (push (cons group v) groups-alist)))
			   ((assq group groups-alist)
			    (push
			     (list
			      (or (org-element-post-affiliated datum)
				  (org-element-begin datum))
			      (format
			       "Forbidden combination in header \"%s\": %s, %s"
			       (car header)
			       (cdr (assq group groups-alist))
			       v))
			     reports)
			    (throw 'exit nil))
			   (t (push (cons group v) groups-alist)
			      (setf valid-value t))))
			(unless valid-value
			  (push
			   (list
			    (or (org-element-post-affiliated datum)
				(org-element-begin datum))
			    (format "Unknown value \"%s\" for header \"%s\""
				    v
				    (car header)))
			   reports))))))))))))
    reports))

(defun org-lint-named-result (ast)
  (org-element-map ast org-element-all-elements
    (lambda (el)
      (when-let* ((result (org-element-property :results el))
                  (result-name (org-element-property :name el))
                  (origin-block
                   (if (org-string-nw-p (car result))
                       (condition-case _
                           (org-export-resolve-link (car result) `(:parse-tree ,ast))
                         (org-link-broken nil))
                     (org-export-get-previous-element el nil))))
        (when (org-element-type-p origin-block 'src-block)
          (list (org-element-begin el)
                (format "Links to \"%s\" will not be valid during export unless the parent source block has :exports results or both" result-name)))))))

(defun org-lint-spurious-colons (ast)
  (org-element-map ast '(headline inlinetask)
    (lambda (h)
      (when (member "" (org-element-property :tags h))
	(list (org-element-begin h)
	      "Tags contain a spurious colon")))))

(defun org-lint-non-existent-bibliography (ast)
  (org-element-map ast 'keyword
    (lambda (k)
      (when (equal "BIBLIOGRAPHY" (org-element-property :key k))
        (let ((file (org-strip-quotes (org-element-property :value k))))
          (and (not (file-remote-p file))
	       (not (file-exists-p file))
	       (list (org-element-begin k)
		     (format "Non-existent bibliography %S" file))))))))

(defun org-lint-missing-print-bibliography (ast)
  (and (org-element-map ast 'citation #'identity nil t)
       (not (org-element-map ast 'keyword
              (lambda (k)
                (equal "PRINT_BIBLIOGRAPHY" (org-element-property :key k)))
              nil t))
       (list
        (list (point-max) "Possibly missing \"PRINT_BIBLIOGRAPHY\" keyword"))))

(defun org-lint-invalid-cite-export-declaration (ast)
  (org-element-map ast 'keyword
    (lambda (k)
      (when (equal "CITE_EXPORT" (org-element-property :key k))
        (let ((value (org-element-property :value k))
              (source (org-element-begin k)))
          (if (equal value "")
              (list source "Missing export processor name")
            (condition-case _
                (pcase (org-cite-read-processor-declaration value)
                  (`(,(and (pred symbolp) name)
                     ,(pred string-or-null-p)
                     ,(pred string-or-null-p))
                   (unless (or (org-cite-get-processor name)
                               (progn
                                 (org-cite-try-load-processor name)
                                 (org-cite-get-processor name)))
                     (list source (format "Unknown cite export processor %S" name))))
                  (_
                   (list source "Invalid cite export processor declaration")))
              (error
               (list source "Invalid cite export processor declaration")))))))))

(defun org-lint-incomplete-citation (ast)
  (org-element-map ast 'plain-text
    (lambda (text)
      (and (string-match-p org-element-citation-prefix-re text)
           ;; XXX: The code below signals the error at the beginning
           ;; of the paragraph containing the faulty object.  It is
           ;; not very accurate but may be enough for now.
           (list (org-element-contents-begin
                                       (org-element-parent text))
                 "Possibly incomplete citation markup")))))

(defun org-lint-item-number (ast)
  (org-element-map ast 'item
    (lambda (item)
      (unless (org-element-property :counter item)
        (when-let* ((bullet (org-element-property :bullet item))
                    (bullet-number
                     (cond
                      ((string-match "[A-Za-z]" bullet)
		       (- (string-to-char (upcase (match-string 0 bullet)))
			  64))
                      ((string-match "[0-9]+" bullet)
		       (string-to-number (match-string 0 bullet)))))
                    (true-number
                     (org-list-get-item-number
                      (org-element-begin item)
                      (org-element-property :structure item)
                      (org-list-prevs-alist (org-element-property :structure item))
                      (org-list-parents-alist (org-element-property :structure item)))))
          (unless (equal bullet-number (car (last true-number)))
            (list
             (org-element-begin item)
             (format "Bullet counter \"%s\" is not the same with item position %d.  Consider adding manual [@%d] counter."
                     bullet (car (last true-number)) bullet-number))))))))

(defun org-lint-LaTeX-$ (ast)
  "Report semi-obsolete $...$ LaTeX fragments.
AST is the buffer parse tree."
  (org-element-map ast 'latex-fragment
    (lambda (fragment)
      (and (string-match-p "^[$][^$]" (org-element-property :value fragment))
           (list (org-element-begin fragment)
                 "Potentially confusing LaTeX fragment format.  Prefer using more reliable \\(...\\)")))))

(defun org-lint-LaTeX-$-ambiguous (_)
  "Report LaTeX fragment-like text.
AST is the buffer parse tree."
  (org-with-wide-buffer
   (let ((ambiguous-latex-re (rx "$." digit))
         report context)
     (while (re-search-forward ambiguous-latex-re nil t)
       (setq context (org-element-context))
       (when (or (eq 'latex-fragment (org-element-type context))
                 (memq 'latex-fragment (org-element-restriction context)))
         (push
          (list
           (point)
           "$ symbol potentially matching LaTeX fragment boundary.  Consider using \\dollar entity.")
          report)))
     report)))

(defun org-lint-timestamp-syntax (ast)
  "Report malformed timestamps.
AST is the buffer parse tree."
  (org-element-map ast 'timestamp
    (lambda (timestamp)
      (let ((expected (org-element-interpret-data timestamp))
            (actual (buffer-substring-no-properties
                     (org-element-property :begin timestamp)
                     (org-element-property :end timestamp))))
        (unless (equal expected actual)
          (list (org-element-property :begin timestamp)
                (format "Potentially malformed timestamp %s.  Parsed as: %s" actual expected)))))))

(defun org-lint-clock-syntax (ast)
  "Report malformed clocks.
AST is the buffer parse tree."
  (org-element-map ast 'clock
    (lambda (clock)
      (let ((expected (string-trim-right (org-element-interpret-data clock)))
            (actual (string-trim
                     (buffer-substring-no-properties
                      (org-element-property :begin clock)
                      (org-element-property :end clock)))))
        (unless (equal expected actual)
          (list (org-element-property :begin clock)
                (format "Potentially malformed CLOCK: line
           %s
Parsed as: %s" actual expected)))))))

(defun org-lint-inactive-planning (ast)
  "Report inactive timestamp in SCHEDULED/DEADLINE.
AST is the buffer parse tree."
  (org-element-map ast 'planning
    (lambda (planning)
      (let ((scheduled (org-element-property :scheduled planning))
            (deadline (org-element-property :deadline planning)))
        (cond
         ((memq (org-element-property :type scheduled) '(inactive inactive-range))
          (list (org-element-begin planning) "Inactive timestamp in SCHEDULED will not appear in agenda."))
         ((memq (org-element-property :type deadline) '(inactive inactive-range))
          (list (org-element-begin planning) "Inactive timestamp in DEADLINE will not appear in agenda."))
         (t nil))))))

(defvar org-beamer-frame-environment) ; defined in ox-beamer.el
(defun org-lint-beamer-frame (ast)
  "Check for occurrences of begin or end frame."
  (require 'ox-beamer)
  (org-with-point-at ast
    (goto-char (point-min))
    (let (result)
      (while (re-search-forward
              (concat "\\\\\\(begin\\|end\\){" org-beamer-frame-environment "}") nil t)
        (push (list (match-beginning 0) "Beamer frame name may cause error when exporting.  Consider customizing `org-beamer-frame-environment'.") result))
      result)))

\f
;;; Checkers declaration

(org-lint-add-checker 'misplaced-heading
  "Report accidentally misplaced heading lines."
  #'org-lint-misplaced-heading :trust 'low)

(org-lint-add-checker 'duplicate-custom-id
  "Report duplicates CUSTOM_ID properties"
  #'org-lint-duplicate-custom-id
  :categories '(link))

(org-lint-add-checker 'duplicate-name
  "Report duplicate NAME values"
  #'org-lint-duplicate-name
  :categories '(babel 'link))

(org-lint-add-checker 'duplicate-target
  "Report duplicate targets"
  #'org-lint-duplicate-target
  :categories '(link))

(org-lint-add-checker 'duplicate-footnote-definition
  "Report duplicate footnote definitions"
  #'org-lint-duplicate-footnote-definition
  :categories '(footnote))

(org-lint-add-checker 'orphaned-affiliated-keywords
  "Report orphaned affiliated keywords"
  #'org-lint-orphaned-affiliated-keywords
  :trust 'low)

(org-lint-add-checker 'combining-keywords-with-affiliated
  "Report independent keywords preceding affiliated keywords."
  #'org-lint-regular-keyword-before-affiliated
  :trust 'low)

(org-lint-add-checker 'obsolete-affiliated-keywords
  "Report obsolete affiliated keywords"
  #'org-lint-obsolete-affiliated-keywords
  :categories '(obsolete))

(org-lint-add-checker 'deprecated-export-blocks
  "Report deprecated export block syntax"
  #'org-lint-deprecated-export-blocks
  :trust 'low :categories '(obsolete export))

(org-lint-add-checker 'deprecated-header-syntax
  "Report deprecated Babel header syntax"
  #'org-lint-deprecated-header-syntax
  :trust 'low :categories '(obsolete babel))

(org-lint-add-checker 'missing-language-in-src-block
  "Report missing language in source blocks"
  #'org-lint-missing-language-in-src-block
  :categories '(babel))

(org-lint-add-checker 'suspicious-language-in-src-block
  "Report suspicious language in source blocks"
  #'org-lint-suspicious-language-in-src-block
  :trust 'low :categories '(babel))

(org-lint-add-checker 'missing-backend-in-export-block
  "Report missing backend in export blocks"
  #'org-lint-missing-backend-in-export-block
  :categories '(export))

(org-lint-add-checker 'invalid-babel-call-block
  "Report invalid Babel call blocks"
  #'org-lint-invalid-babel-call-block
  :categories '(babel))

(org-lint-add-checker 'wrong-header-argument
  "Report wrong babel headers"
  #'org-lint-wrong-header-argument
  :categories '(babel))

(org-lint-add-checker 'wrong-header-value
  "Report invalid value in babel headers"
  #'org-lint-wrong-header-value
  :categories '(babel) :trust 'low)

(org-lint-add-checker 'named-result
  "Report results evaluation with #+name keyword."
  #'org-lint-named-result
  :categories '(babel) :trust 'high)

(org-lint-add-checker 'empty-header-argument
  "Report empty values in babel headers"
  #'org-lint-empty-header-argument
  :categories '(babel) :trust 'low)

(org-lint-add-checker 'deprecated-category-setup
  "Report misuse of CATEGORY keyword"
  #'org-lint-deprecated-category-setup
  :categories '(obsolete))

(org-lint-add-checker 'invalid-coderef-link
  "Report \"coderef\" links with unknown destination"
  #'org-lint-invalid-coderef-link
  :categories '(link))

(org-lint-add-checker 'invalid-custom-id-link
  "Report \"custom-id\" links with unknown destination"
  #'org-lint-invalid-custom-id-link
  :categories '(link))

(org-lint-add-checker 'invalid-fuzzy-link
  "Report \"fuzzy\" links with unknown destination"
  #'org-lint-invalid-fuzzy-link
  :categories '(link))

(org-lint-add-checker 'invalid-id-link
  "Report \"id\" links with unknown destination"
  #'org-lint-invalid-id-link
  :categories '(link))

(org-lint-add-checker 'trailing-bracket-after-link
  "Report potentially confused trailing ']' after link."
  #'org-lint-confusing-brackets
  :categories '(link) :trust 'low)

(org-lint-add-checker 'unclosed-brackets-in-link-description
  "Report potentially confused trailing ']' after link."
  #'org-lint-brackets-inside-description
  :categories '(link) :trust 'low)

(org-lint-add-checker 'link-to-local-file
  "Report links to non-existent local files"
  #'org-lint-link-to-local-file
  :categories '(link) :trust 'low)

(org-lint-add-checker 'non-existent-setupfile-parameter
  "Report SETUPFILE keywords with non-existent file parameter"
  #'org-lint-non-existent-setupfile-parameter
  :trust 'low)

(org-lint-add-checker 'wrong-include-link-parameter
  "Report INCLUDE keywords with misleading link parameter"
  #'org-lint-wrong-include-link-parameter
  :categories '(export) :trust 'low)

(org-lint-add-checker 'obsolete-include-markup
  "Report obsolete markup in INCLUDE keyword"
  #'org-lint-obsolete-include-markup
  :categories '(obsolete export) :trust 'low)

(org-lint-add-checker 'unknown-options-item
  "Report unknown items in OPTIONS keyword"
  #'org-lint-unknown-options-item
  :categories '(export) :trust 'low)

(org-lint-add-checker 'misspelled-export-option
  "Report potentially misspelled export options in properties."
  #'org-lint-export-option-keywords
  :categories '(export) :trust 'low)

(org-lint-add-checker 'invalid-macro-argument-and-template
  "Report spurious macro arguments or invalid macro templates"
  #'org-lint-invalid-macro-argument-and-template
  :categories '(export) :trust 'low)

(org-lint-add-checker 'special-property-in-properties-drawer
  "Report special properties in properties drawers"
  #'org-lint-special-property-in-properties-drawer
  :categories '(properties))

(org-lint-add-checker 'obsolete-properties-drawer
  "Report obsolete syntax for properties drawers"
  #'org-lint-obsolete-properties-drawer
  :categories '(obsolete properties))

(org-lint-add-checker 'invalid-effort-property
  "Report invalid duration in EFFORT property"
  #'org-lint-invalid-effort-property
  :categories '(properties))

(org-lint-add-checker 'invalid-id-property
  "Report search string delimiter \"::\" in ID property"
  #'org-lint-invalid-id-property
  :categories '(properties))

(org-lint-add-checker 'undefined-footnote-reference
  "Report missing definition for footnote references"
  #'org-lint-undefined-footnote-reference
  :categories '(footnote))

(org-lint-add-checker 'unreferenced-footnote-definition
  "Report missing reference for footnote definitions"
  #'org-lint-unreferenced-footnote-definition
  :categories '(footnote))

(org-lint-add-checker 'extraneous-element-in-footnote-section
  "Report non-footnote definitions in footnote section"
  #'org-lint-extraneous-element-in-footnote-section
  :categories '(footnote))

(org-lint-add-checker 'invalid-keyword-syntax
  "Report probable invalid keywords"
  #'org-lint-invalid-keyword-syntax
  :trust 'low)

(org-lint-add-checker 'invalid-image-alignment
  "Report unsupported align attribute for keyword"
  #'org-lint-invalid-image-alignment
  :trust 'high)

(org-lint-add-checker 'invalid-block
  "Report invalid blocks"
  #'org-lint-invalid-block
  :trust 'low)

(org-lint-add-checker 'mismatched-planning-repeaters
  "Report mismatched repeaters in planning info line"
  #'org-lint-mismatched-planning-repeaters
  :trust 'low)

(org-lint-add-checker 'misplaced-planning-info
  "Report misplaced planning info line"
  #'org-lint-misplaced-planning-info
  :trust 'low)

(org-lint-add-checker 'incomplete-drawer
  "Report probable incomplete drawers"
  #'org-lint-incomplete-drawer
  :trust 'low)

(org-lint-add-checker 'indented-diary-sexp
  "Report probable indented diary-sexps"
  #'org-lint-indented-diary-sexp
  :trust 'low)

(org-lint-add-checker 'quote-section
  "Report obsolete QUOTE section"
  #'org-lint-quote-section
  :categories '(obsolete) :trust 'low)

(org-lint-add-checker 'file-application
  "Report obsolete \"file+application\" link"
  #'org-lint-file-application
  :categories '(link obsolete))

(org-lint-add-checker 'percent-encoding-link-escape
  "Report obsolete escape syntax in links"
  #'org-lint-percent-encoding-link-escape
  :categories '(link obsolete) :trust 'low)

(org-lint-add-checker 'spurious-colons
  "Report spurious colons in tags"
  #'org-lint-spurious-colons
  :categories '(tags))

(org-lint-add-checker 'non-existent-bibliography
  "Report invalid bibliography file"
  #'org-lint-non-existent-bibliography
  :categories '(cite))

(org-lint-add-checker 'missing-print-bibliography
  "Report missing \"print_bibliography\" keyword"
  #'org-lint-missing-print-bibliography
  :categories '(cite))

(org-lint-add-checker 'invalid-cite-export-declaration
  "Report invalid value for \"cite_export\" keyword"
  #'org-lint-invalid-cite-export-declaration
  :categories '(cite))

(org-lint-add-checker 'incomplete-citation
  "Report incomplete citation object"
  #'org-lint-incomplete-citation
  :categories '(cite) :trust 'low)

(org-lint-add-checker 'item-number
  "Report inconsistent item numbers in lists"
  #'org-lint-item-number
  :categories '(plain-list))

(org-lint-add-checker 'LaTeX-$
  "Report potentially confusing $...$ LaTeX markup."
  #'org-lint-LaTeX-$
  :categories '(markup))
(org-lint-add-checker 'LaTeX-$
  "Report $ that might be treated as LaTeX fragment boundary."
  #'org-lint-LaTeX-$-ambiguous
  :categories '(markup) :trust 'low)
(org-lint-add-checker 'beamer-frame
  "Report that frame text contains beamer frame environment."
  #'org-lint-beamer-frame
  :categories '(export) :trust 'low)
(org-lint-add-checker 'timestamp-syntax
  "Report malformed timestamps."
  #'org-lint-timestamp-syntax
  :categories '(timestamp) :trust 'low)
(org-lint-add-checker 'clock-syntax
  "Report malformed clocks."
  #'org-lint-clock-syntax
  :categories '(timestamp) :trust 'low)
(org-lint-add-checker 'planning-inactive
  "Report inactive timestamps in SCHEDULED/DEADLINE."
  #'org-lint-inactive-planning
  :categories '(timestamp) :trust 'high)

(provide 'org-lint)

;; Local variables:
;; generated-autoload-file: "org-loaddefs.el"
;; End:

;;; org-lint.el ends here