org-lint.el 49 KB

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