lisp/org-lint.el

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