org-lint.el 39 KB

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