org-lint.el 43 KB

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