org-lint.el 50 KB

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