lisp/org-lint.el

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