ox-publish.el 51 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889909192939495969798991001011021031041051061071081091101111121131141151161171181191201211221231241251261271281291301311321331341351361371381391401411421431441451461471481491501511521531541551561571581591601611621631641651661671681691701711721731741751761771781791801811821831841851861871881891901911921931941951961971981992002012022032042052062072082092102112122132142152162172182192202212222232242252262272282292302312322332342352362372382392402412422432442452462472482492502512522532542552562572582592602612622632642652662672682692702712722732742752762772782792802812822832842852862872882892902912922932942952962972982993003013023033043053063073083093103113123133143153163173183193203213223233243253263273283293303313323333343353363373383393403413423433443453463473483493503513523533543553563573583593603613623633643653663673683693703713723733743753763773783793803813823833843853863873883893903913923933943953963973983994004014024034044054064074084094104114124134144154164174184194204214224234244254264274284294304314324334344354364374384394404414424434444454464474484494504514524534544554564574584594604614624634644654664674684694704714724734744754764774784794804814824834844854864874884894904914924934944954964974984995005015025035045055065075085095105115125135145155165175185195205215225235245255265275285295305315325335345355365375385395405415425435445455465475485495505515525535545555565575585595605615625635645655665675685695705715725735745755765775785795805815825835845855865875885895905915925935945955965975985996006016026036046056066076086096106116126136146156166176186196206216226236246256266276286296306316326336346356366376386396406416426436446456466476486496506516526536546556566576586596606616626636646656666676686696706716726736746756766776786796806816826836846856866876886896906916926936946956966976986997007017027037047057067077087097107117127137147157167177187197207217227237247257267277287297307317327337347357367377387397407417427437447457467477487497507517527537547557567577587597607617627637647657667677687697707717727737747757767777787797807817827837847857867877887897907917927937947957967977987998008018028038048058068078088098108118128138148158168178188198208218228238248258268278288298308318328338348358368378388398408418428438448458468478488498508518528538548558568578588598608618628638648658668678688698708718728738748758768778788798808818828838848858868878888898908918928938948958968978988999009019029039049059069079089099109119129139149159169179189199209219229239249259269279289299309319329339349359369379389399409419429439449459469479489499509519529539549559569579589599609619629639649659669679689699709719729739749759769779789799809819829839849859869879889899909919929939949959969979989991000100110021003100410051006100710081009101010111012101310141015101610171018101910201021102210231024102510261027102810291030103110321033103410351036103710381039104010411042104310441045104610471048104910501051105210531054105510561057105810591060106110621063106410651066106710681069107010711072107310741075107610771078107910801081108210831084108510861087108810891090109110921093109410951096109710981099110011011102110311041105110611071108110911101111111211131114111511161117111811191120112111221123112411251126112711281129113011311132113311341135113611371138113911401141114211431144114511461147114811491150115111521153115411551156115711581159116011611162116311641165116611671168116911701171117211731174117511761177117811791180118111821183118411851186118711881189119011911192119311941195119611971198119912001201120212031204120512061207120812091210121112121213121412151216121712181219122012211222122312241225122612271228122912301231123212331234123512361237123812391240124112421243124412451246124712481249125012511252125312541255125612571258125912601261126212631264126512661267126812691270127112721273127412751276127712781279128012811282128312841285128612871288128912901291129212931294129512961297129812991300130113021303130413051306130713081309131013111312131313141315131613171318131913201321132213231324132513261327132813291330133113321333133413351336133713381339134013411342134313441345134613471348134913501351135213531354135513561357135813591360136113621363136413651366136713681369137013711372137313741375137613771378
  1. ;;; ox-publish.el --- Publish Related Org Mode Files as a Website -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2006-2018 Free Software Foundation, Inc.
  3. ;; Author: David O'Toole <dto@gnu.org>
  4. ;; Maintainer: Carsten Dominik <carsten DOT dominik AT gmail DOT com>
  5. ;; Keywords: hypermedia, outlines, wp
  6. ;; This file is part of GNU Emacs.
  7. ;;
  8. ;; GNU Emacs is free software: you can redistribute it and/or modify
  9. ;; it under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation, either version 3 of the License, or
  11. ;; (at your option) any later version.
  12. ;; GNU Emacs is distributed in the hope that it will be useful,
  13. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  14. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  15. ;; GNU General Public License for more details.
  16. ;; You should have received a copy of the GNU General Public License
  17. ;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
  18. ;;; Commentary:
  19. ;; This program allow configurable publishing of related sets of
  20. ;; Org mode files as a complete website.
  21. ;;
  22. ;; ox-publish.el can do the following:
  23. ;;
  24. ;; + Publish all one's Org files to a given export back-end
  25. ;; + Upload HTML, images, attachments and other files to a web server
  26. ;; + Exclude selected private pages from publishing
  27. ;; + Publish a clickable sitemap of pages
  28. ;; + Manage local timestamps for publishing only changed files
  29. ;; + Accept plugin functions to extend range of publishable content
  30. ;;
  31. ;; Documentation for publishing is in the manual.
  32. ;;; Code:
  33. (require 'cl-lib)
  34. (require 'format-spec)
  35. (require 'ox)
  36. ;;; Variables
  37. ;; Here, so you find the variable right before it's used the first time:
  38. (defvar org-publish-cache nil
  39. "This will cache timestamps and titles for files in publishing projects.
  40. Blocks could hash sha1 values here.")
  41. (defvar org-publish-after-publishing-hook nil
  42. "Hook run each time a file is published.
  43. Every function in this hook will be called with two arguments:
  44. the name of the original file and the name of the file
  45. produced.")
  46. (defgroup org-export-publish nil
  47. "Options for publishing a set of files."
  48. :tag "Org Publishing"
  49. :group 'org-export)
  50. (defcustom org-publish-project-alist nil
  51. "Association list to control publishing behavior.
  52. \\<org-mode-map>
  53. Each element of the alist is a publishing project. The car of
  54. each element is a string, uniquely identifying the project. The
  55. cdr of each element is in one of the following forms:
  56. 1. A well-formed property list with an even number of elements,
  57. alternating keys and values, specifying parameters for the
  58. publishing process.
  59. (:property value :property value ... )
  60. 2. A meta-project definition, specifying of a list of
  61. sub-projects:
  62. (:components (\"project-1\" \"project-2\" ...))
  63. When the CDR of an element of org-publish-project-alist is in
  64. this second form, the elements of the list after `:components'
  65. are taken to be components of the project, which group together
  66. files requiring different publishing options. When you publish
  67. such a project with `\\[org-publish]', the components all publish.
  68. When a property is given a value in `org-publish-project-alist',
  69. its setting overrides the value of the corresponding user
  70. variable (if any) during publishing. However, options set within
  71. a file override everything.
  72. Most properties are optional, but some should always be set:
  73. `:base-directory'
  74. Directory containing publishing source files.
  75. `:base-extension'
  76. Extension (without the dot!) of source files. This can be
  77. a regular expression. If not given, \"org\" will be used as
  78. default extension. If it is `any', include all the files,
  79. even without extension.
  80. `:publishing-directory'
  81. Directory (possibly remote) where output files will be
  82. published.
  83. If `:recursive' is non-nil files in sub-directories of
  84. `:base-directory' are considered.
  85. The `:exclude' property may be used to prevent certain files from
  86. being published. Its value may be a string or regexp matching
  87. file names you don't want to be published.
  88. The `:include' property may be used to include extra files. Its
  89. value may be a list of filenames to include. The filenames are
  90. considered relative to the base directory.
  91. When both `:include' and `:exclude' properties are given values,
  92. the exclusion step happens first.
  93. One special property controls which back-end function to use for
  94. publishing files in the project. This can be used to extend the
  95. set of file types publishable by `org-publish', as well as the
  96. set of output formats.
  97. `:publishing-function'
  98. Function to publish file. Each back-end may define its
  99. own (i.e. `org-latex-publish-to-pdf',
  100. `org-html-publish-to-html'). May be a list of functions, in
  101. which case each function in the list is invoked in turn.
  102. Another property allows you to insert code that prepares
  103. a project for publishing. For example, you could call GNU Make
  104. on a certain makefile, to ensure published files are built up to
  105. date.
  106. `:preparation-function'
  107. Function to be called before publishing this project. This
  108. may also be a list of functions. Preparation functions are
  109. called with the project properties list as their sole
  110. argument.
  111. `:completion-function'
  112. Function to be called after publishing this project. This
  113. may also be a list of functions. Completion functions are
  114. called with the project properties list as their sole
  115. argument.
  116. Some properties control details of the Org publishing process,
  117. and are equivalent to the corresponding user variables listed in
  118. the right column. Back-end specific properties may also be
  119. included. See the back-end documentation for more information.
  120. :author `user-full-name'
  121. :creator `org-export-creator-string'
  122. :email `user-mail-address'
  123. :exclude-tags `org-export-exclude-tags'
  124. :headline-levels `org-export-headline-levels'
  125. :language `org-export-default-language'
  126. :preserve-breaks `org-export-preserve-breaks'
  127. :section-numbers `org-export-with-section-numbers'
  128. :select-tags `org-export-select-tags'
  129. :time-stamp-file `org-export-time-stamp-file'
  130. :with-archived-trees `org-export-with-archived-trees'
  131. :with-author `org-export-with-author'
  132. :with-creator `org-export-with-creator'
  133. :with-date `org-export-with-date'
  134. :with-drawers `org-export-with-drawers'
  135. :with-email `org-export-with-email'
  136. :with-emphasize `org-export-with-emphasize'
  137. :with-entities `org-export-with-entities'
  138. :with-fixed-width `org-export-with-fixed-width'
  139. :with-footnotes `org-export-with-footnotes'
  140. :with-inlinetasks `org-export-with-inlinetasks'
  141. :with-latex `org-export-with-latex'
  142. :with-planning `org-export-with-planning'
  143. :with-priority `org-export-with-priority'
  144. :with-properties `org-export-with-properties'
  145. :with-smart-quotes `org-export-with-smart-quotes'
  146. :with-special-strings `org-export-with-special-strings'
  147. :with-statistics-cookies' `org-export-with-statistics-cookies'
  148. :with-sub-superscript `org-export-with-sub-superscripts'
  149. :with-toc `org-export-with-toc'
  150. :with-tables `org-export-with-tables'
  151. :with-tags `org-export-with-tags'
  152. :with-tasks `org-export-with-tasks'
  153. :with-timestamps `org-export-with-timestamps'
  154. :with-title `org-export-with-title'
  155. :with-todo-keywords `org-export-with-todo-keywords'
  156. The following properties may be used to control publishing of
  157. a site-map of files or summary page for a given project.
  158. `:auto-sitemap'
  159. Whether to publish a site-map during
  160. `org-publish-current-project' or `org-publish-all'.
  161. `:sitemap-filename'
  162. Filename for output of site-map. Defaults to \"sitemap.org\".
  163. `:sitemap-title'
  164. Title of site-map page. Defaults to name of file.
  165. `:sitemap-style'
  166. Can be `list' (site-map is just an itemized list of the
  167. titles of the files involved) or `tree' (the directory
  168. structure of the source files is reflected in the site-map).
  169. Defaults to `tree'.
  170. `:sitemap-format-entry'
  171. Plugin function used to format entries in the site-map. It
  172. is called with three arguments: the file or directory name
  173. relative to base directory, the site map style and the
  174. current project. It has to return a string.
  175. Defaults to `org-publish-sitemap-default-entry', which turns
  176. file names into links and use document titles as
  177. descriptions. For specific formatting needs, one can use
  178. `org-publish-find-date', `org-publish-find-title' and
  179. `org-publish-find-property', to retrieve additional
  180. information about published documents.
  181. `:sitemap-function'
  182. Plugin function to use for generation of site-map. It is
  183. called with two arguments: the title of the site-map, as
  184. a string, and a representation of the files involved in the
  185. project, as returned by `org-list-to-lisp'. The latter can
  186. further be transformed using `org-list-to-generic',
  187. `org-list-to-subtree' and alike. It has to return a string.
  188. Defaults to `org-publish-sitemap-default', which generates
  189. a plain list of links to all files in the project.
  190. If you create a site-map file, adjust the sorting like this:
  191. `:sitemap-sort-folders'
  192. Where folders should appear in the site-map. Set this to
  193. `first' or `last' to display folders first or last,
  194. respectively. When set to `ignore' (default), folders are
  195. ignored altogether. Any other value will mix files and
  196. folders. This variable has no effect when site-map style is
  197. `tree'.
  198. `:sitemap-sort-files'
  199. The site map is normally sorted alphabetically. You can
  200. change this behavior setting this to `anti-chronologically',
  201. `chronologically', or nil.
  202. `:sitemap-ignore-case'
  203. Should sorting be case-sensitive? Default nil.
  204. The following property control the creation of a concept index.
  205. `:makeindex'
  206. Create a concept index. The file containing the index has to
  207. be called \"theindex.org\". If it doesn't exist in the
  208. project, it will be generated. Contents of the index are
  209. stored in the file \"theindex.inc\", which can be included in
  210. \"theindex.org\".
  211. Other properties affecting publication.
  212. `:body-only'
  213. Set this to t to publish only the body of the documents."
  214. :group 'org-export-publish
  215. :type 'alist)
  216. (defcustom org-publish-use-timestamps-flag t
  217. "Non-nil means use timestamp checking to publish only changed files.
  218. When nil, do no timestamp checking and always publish all files."
  219. :group 'org-export-publish
  220. :type 'boolean)
  221. (defcustom org-publish-timestamp-directory
  222. (convert-standard-filename "~/.org-timestamps/")
  223. "Name of directory in which to store publishing timestamps."
  224. :group 'org-export-publish
  225. :type 'directory)
  226. (defcustom org-publish-list-skipped-files t
  227. "Non-nil means show message about files *not* published."
  228. :group 'org-export-publish
  229. :type 'boolean)
  230. (defcustom org-publish-sitemap-sort-files 'alphabetically
  231. "Method to sort files in site-maps.
  232. Possible values are `alphabetically', `chronologically',
  233. `anti-chronologically' and nil.
  234. If `alphabetically', files will be sorted alphabetically. If
  235. `chronologically', files will be sorted with older modification
  236. time first. If `anti-chronologically', files will be sorted with
  237. newer modification time first. nil won't sort files.
  238. You can overwrite this default per project in your
  239. `org-publish-project-alist', using `:sitemap-sort-files'."
  240. :group 'org-export-publish
  241. :type 'symbol)
  242. (defcustom org-publish-sitemap-sort-folders 'ignore
  243. "A symbol, denoting if folders are sorted first in site-maps.
  244. Possible values are `first', `last', `ignore' and nil.
  245. If `first', folders will be sorted before files.
  246. If `last', folders are sorted to the end after the files.
  247. If `ignore', folders do not appear in the site-map.
  248. Any other value will mix files and folders.
  249. You can overwrite this default per project in your
  250. `org-publish-project-alist', using `:sitemap-sort-folders'.
  251. This variable is ignored when site-map style is `tree'."
  252. :group 'org-export-publish
  253. :type '(choice
  254. (const :tag "Folders before files" first)
  255. (const :tag "Folders after files" last)
  256. (const :tag "No folder in site-map" ignore)
  257. (const :tag "Mix folders and files" nil))
  258. :version "26.1"
  259. :package-version '(Org . "9.1")
  260. :safe #'symbolp)
  261. (defcustom org-publish-sitemap-sort-ignore-case nil
  262. "Non-nil when site-map sorting should ignore case.
  263. You can overwrite this default per project in your
  264. `org-publish-project-alist', using `:sitemap-ignore-case'."
  265. :group 'org-export-publish
  266. :type 'boolean)
  267. ;;; Timestamp-related functions
  268. (defun org-publish-timestamp-filename (filename &optional pub-dir pub-func)
  269. "Return path to timestamp file for filename FILENAME."
  270. (setq filename (concat filename "::" (or pub-dir "") "::"
  271. (format "%s" (or pub-func ""))))
  272. (concat "X" (if (fboundp 'sha1) (sha1 filename) (md5 filename))))
  273. (defun org-publish-needed-p
  274. (filename &optional pub-dir pub-func _true-pub-dir base-dir)
  275. "Non-nil if FILENAME should be published in PUB-DIR using PUB-FUNC.
  276. TRUE-PUB-DIR is where the file will truly end up. Currently we
  277. are not using this - maybe it can eventually be used to check if
  278. the file is present at the target location, and how old it is.
  279. Right now we cannot do this, because we do not know under what
  280. file name the file will be stored - the publishing function can
  281. still decide about that independently."
  282. (let ((rtn (if (not org-publish-use-timestamps-flag) t
  283. (org-publish-cache-file-needs-publishing
  284. filename pub-dir pub-func base-dir))))
  285. (if rtn (message "Publishing file %s using `%s'" filename pub-func)
  286. (when org-publish-list-skipped-files
  287. (message "Skipping unmodified file %s" filename)))
  288. rtn))
  289. (defun org-publish-update-timestamp
  290. (filename &optional pub-dir pub-func _base-dir)
  291. "Update publishing timestamp for file FILENAME.
  292. If there is no timestamp, create one."
  293. (let ((key (org-publish-timestamp-filename filename pub-dir pub-func))
  294. (stamp (org-publish-cache-ctime-of-src filename)))
  295. (org-publish-cache-set key stamp)))
  296. (defun org-publish-remove-all-timestamps ()
  297. "Remove all files in the timestamp directory."
  298. (let ((dir org-publish-timestamp-directory))
  299. (when (and (file-exists-p dir) (file-directory-p dir))
  300. (mapc #'delete-file (directory-files dir 'full "[^.]\\'"))
  301. (org-publish-reset-cache))))
  302. ;;; Getting project information out of `org-publish-project-alist'
  303. (defun org-publish-property (property project &optional default)
  304. "Return value PROPERTY, as a symbol, in PROJECT.
  305. DEFAULT is returned when PROPERTY is not actually set in PROJECT
  306. definition."
  307. (let ((properties (cdr project)))
  308. (if (plist-member properties property)
  309. (plist-get properties property)
  310. default)))
  311. (defun org-publish--expand-file-name (file project)
  312. "Return full file name for FILE in PROJECT.
  313. When FILE is a relative file name, it is expanded according to
  314. project base directory."
  315. (if (file-name-absolute-p file) file
  316. (expand-file-name file (org-publish-property :base-directory project))))
  317. (defun org-publish-expand-projects (projects-alist)
  318. "Expand projects in PROJECTS-ALIST.
  319. This splices all the components into the list."
  320. (let ((rest projects-alist) rtn p components)
  321. (while (setq p (pop rest))
  322. (if (setq components (plist-get (cdr p) :components))
  323. (setq rest (append
  324. (mapcar
  325. (lambda (x)
  326. (or (assoc x org-publish-project-alist)
  327. (user-error "Unknown component %S in project %S"
  328. x (car p))))
  329. components)
  330. rest))
  331. (push p rtn)))
  332. (nreverse (delete-dups (delq nil rtn)))))
  333. (defun org-publish-get-base-files (project)
  334. "Return a list of all files in PROJECT."
  335. (let* ((base-dir (file-name-as-directory
  336. (org-publish-property :base-directory project)))
  337. (extension (or (org-publish-property :base-extension project) "org"))
  338. (match (if (eq extension 'any) ""
  339. (format "^[^\\.].*\\.\\(%s\\)$" extension)))
  340. (base-files
  341. (cond ((not (file-exists-p base-dir)) nil)
  342. ((not (org-publish-property :recursive project))
  343. (cl-remove-if #'file-directory-p
  344. (directory-files base-dir t match t)))
  345. (t
  346. ;; Find all files recursively. Unlike to
  347. ;; `directory-files-recursively', we follow symlinks
  348. ;; to other directories.
  349. (letrec ((files nil)
  350. (walk-tree
  351. (lambda (dir depth)
  352. (when (> depth 100)
  353. (error "Apparent cycle of symbolic links for %S"
  354. base-dir))
  355. (dolist (f (file-name-all-completions "" dir))
  356. (pcase f
  357. ((or "./" "../") nil)
  358. ((pred directory-name-p)
  359. (funcall walk-tree
  360. (expand-file-name f dir)
  361. (1+ depth)))
  362. ((pred (string-match match))
  363. (push (expand-file-name f dir) files))
  364. (_ nil)))
  365. files)))
  366. (funcall walk-tree base-dir 0))))))
  367. (org-uniquify
  368. (append
  369. ;; Files from BASE-DIR. Apply exclusion filter before adding
  370. ;; included files.
  371. (let ((exclude-regexp (org-publish-property :exclude project)))
  372. (if exclude-regexp
  373. (cl-remove-if
  374. (lambda (f)
  375. ;; Match against relative names, yet BASE-DIR file
  376. ;; names are absolute.
  377. (string-match exclude-regexp
  378. (file-relative-name f base-dir)))
  379. base-files)
  380. base-files))
  381. ;; Sitemap file.
  382. (and (org-publish-property :auto-sitemap project)
  383. (list (expand-file-name
  384. (or (org-publish-property :sitemap-filename project)
  385. "sitemap.org")
  386. base-dir)))
  387. ;; Included files.
  388. (mapcar (lambda (f) (expand-file-name f base-dir))
  389. (org-publish-property :include project))))))
  390. (defun org-publish-get-project-from-filename (filename &optional up)
  391. "Return a project that FILENAME belongs to.
  392. When UP is non-nil, return a meta-project (i.e., with a :components part)
  393. publishing FILENAME."
  394. (let* ((filename (expand-file-name filename))
  395. (project
  396. (cl-some
  397. (lambda (p)
  398. ;; Ignore meta-projects.
  399. (unless (org-publish-property :components p)
  400. (let ((base (expand-file-name
  401. (org-publish-property :base-directory p))))
  402. (cond
  403. ;; Check if FILENAME is explicitly included in one
  404. ;; project.
  405. ((cl-some (lambda (f) (file-equal-p f filename))
  406. (mapcar (lambda (f) (expand-file-name f base))
  407. (org-publish-property :include p)))
  408. p)
  409. ;; Exclude file names matching :exclude property.
  410. ((let ((exclude-re (org-publish-property :exclude p)))
  411. (and exclude-re
  412. (string-match-p exclude-re
  413. (file-relative-name filename base))))
  414. nil)
  415. ;; Check :extension. Handle special `any'
  416. ;; extension.
  417. ((let ((extension (org-publish-property :base-extension p)))
  418. (not (or (eq extension 'any)
  419. (string= (or extension "org")
  420. (file-name-extension filename)))))
  421. nil)
  422. ;; Check if FILENAME belong to project's base
  423. ;; directory, or some of its sub-directories
  424. ;; if :recursive in non-nil.
  425. ((member filename (org-publish-get-base-files p)) p)
  426. (t nil)))))
  427. org-publish-project-alist)))
  428. (cond
  429. ((not project) nil)
  430. ((not up) project)
  431. ;; When optional argument UP is non-nil, return the top-most
  432. ;; meta-project effectively publishing FILENAME.
  433. (t
  434. (letrec ((find-parent-project
  435. (lambda (project)
  436. (or (cl-some
  437. (lambda (p)
  438. (and (member (car project)
  439. (org-publish-property :components p))
  440. (funcall find-parent-project p)))
  441. org-publish-project-alist)
  442. project))))
  443. (funcall find-parent-project project))))))
  444. ;;; Tools for publishing functions in back-ends
  445. (defun org-publish-org-to (backend filename extension plist &optional pub-dir)
  446. "Publish an Org file to a specified back-end.
  447. BACKEND is a symbol representing the back-end used for
  448. transcoding. FILENAME is the filename of the Org file to be
  449. published. EXTENSION is the extension used for the output
  450. string, with the leading dot. PLIST is the property list for the
  451. given project.
  452. Optional argument PUB-DIR, when non-nil is the publishing
  453. directory.
  454. Return output file name."
  455. (unless (or (not pub-dir) (file-exists-p pub-dir)) (make-directory pub-dir t))
  456. ;; Check if a buffer visiting FILENAME is already open.
  457. (let* ((org-inhibit-startup t)
  458. (visiting (find-buffer-visiting filename))
  459. (work-buffer (or visiting (find-file-noselect filename))))
  460. (unwind-protect
  461. (with-current-buffer work-buffer
  462. (let ((output (org-export-output-file-name extension nil pub-dir)))
  463. (org-export-to-file backend output
  464. nil nil nil (plist-get plist :body-only)
  465. ;; Add `org-publish--store-crossrefs' and
  466. ;; `org-publish-collect-index' to final output filters.
  467. ;; The latter isn't dependent on `:makeindex', since we
  468. ;; want to keep it up-to-date in cache anyway.
  469. (org-combine-plists
  470. plist
  471. `(:crossrefs
  472. ,(org-publish-cache-get-file-property
  473. ;; Normalize file names in cache.
  474. (file-truename filename) :crossrefs nil t)
  475. :filter-final-output
  476. (org-publish--store-crossrefs
  477. org-publish-collect-index
  478. ,@(plist-get plist :filter-final-output)))))))
  479. ;; Remove opened buffer in the process.
  480. (unless visiting (kill-buffer work-buffer)))))
  481. (defun org-publish-attachment (_plist filename pub-dir)
  482. "Publish a file with no transformation of any kind.
  483. FILENAME is the filename of the Org file to be published. PLIST
  484. is the property list for the given project. PUB-DIR is the
  485. publishing directory.
  486. Return output file name."
  487. (unless (file-directory-p pub-dir)
  488. (make-directory pub-dir t))
  489. (let ((output (expand-file-name (file-name-nondirectory filename) pub-dir)))
  490. (unless (file-equal-p (expand-file-name (file-name-directory filename))
  491. (file-name-as-directory (expand-file-name pub-dir)))
  492. (copy-file filename output t))
  493. ;; Return file name.
  494. output))
  495. ;;; Publishing files, sets of files
  496. (defun org-publish-file (filename &optional project no-cache)
  497. "Publish file FILENAME from PROJECT.
  498. If NO-CACHE is not nil, do not initialize `org-publish-cache'.
  499. This is needed, since this function is used to publish single
  500. files, when entire projects are published (see
  501. `org-publish-projects')."
  502. (let* ((project
  503. (or project
  504. (org-publish-get-project-from-filename filename)
  505. (user-error "File %S is not part of any known project"
  506. (abbreviate-file-name filename))))
  507. (project-plist (cdr project))
  508. (publishing-function
  509. (pcase (org-publish-property :publishing-function project)
  510. (`nil (user-error "No publishing function chosen"))
  511. ((and f (pred listp)) f)
  512. (f (list f))))
  513. (base-dir
  514. (file-name-as-directory
  515. (or (org-publish-property :base-directory project)
  516. (user-error "Project %S does not have :base-directory defined"
  517. (car project)))))
  518. (pub-base-dir
  519. (file-name-as-directory
  520. (or (org-publish-property :publishing-directory project)
  521. (user-error
  522. "Project %S does not have :publishing-directory defined"
  523. (car project)))))
  524. (pub-dir
  525. (file-name-directory
  526. (expand-file-name (file-relative-name filename base-dir)
  527. pub-base-dir))))
  528. (unless no-cache (org-publish-initialize-cache (car project)))
  529. ;; Allow chain of publishing functions.
  530. (dolist (f publishing-function)
  531. (when (org-publish-needed-p filename pub-base-dir f pub-dir base-dir)
  532. (let ((output (funcall f project-plist filename pub-dir)))
  533. (org-publish-update-timestamp filename pub-base-dir f base-dir)
  534. (run-hook-with-args 'org-publish-after-publishing-hook
  535. filename
  536. output))))
  537. ;; Make sure to write cache to file after successfully publishing
  538. ;; a file, so as to minimize impact of a publishing failure.
  539. (org-publish-write-cache-file)))
  540. (defun org-publish-projects (projects)
  541. "Publish all files belonging to the PROJECTS alist.
  542. If `:auto-sitemap' is set, publish the sitemap too. If
  543. `:makeindex' is set, also produce a file \"theindex.org\"."
  544. (dolist (project (org-publish-expand-projects projects))
  545. (let ((plist (cdr project)))
  546. (let ((fun (org-publish-property :preparation-function project)))
  547. (cond
  548. ((consp fun) (dolist (f fun) (funcall f plist)))
  549. ((functionp fun) (funcall fun plist))))
  550. ;; Each project uses its own cache file.
  551. (org-publish-initialize-cache (car project))
  552. (when (org-publish-property :auto-sitemap project)
  553. (let ((sitemap-filename
  554. (or (org-publish-property :sitemap-filename project)
  555. "sitemap.org")))
  556. (org-publish-sitemap project sitemap-filename)))
  557. ;; Publish all files from PROJECT except "theindex.org". Its
  558. ;; publishing will be deferred until "theindex.inc" is
  559. ;; populated.
  560. (let ((theindex
  561. (expand-file-name "theindex.org"
  562. (org-publish-property :base-directory project))))
  563. (dolist (file (org-publish-get-base-files project))
  564. (unless (file-equal-p file theindex)
  565. (org-publish-file file project t)))
  566. ;; Populate "theindex.inc", if needed, and publish
  567. ;; "theindex.org".
  568. (when (org-publish-property :makeindex project)
  569. (org-publish-index-generate-theindex
  570. project (org-publish-property :base-directory project))
  571. (org-publish-file theindex project t)))
  572. (let ((fun (org-publish-property :completion-function project)))
  573. (cond
  574. ((consp fun) (dolist (f fun) (funcall f plist)))
  575. ((functionp fun) (funcall fun plist)))))
  576. (org-publish-write-cache-file)))
  577. ;;; Site map generation
  578. (defun org-publish--sitemap-files-to-lisp (files project style format-entry)
  579. "Represent FILES as a parsed plain list.
  580. FILES is the list of files in the site map. PROJECT is the
  581. current project. STYLE determines is either `list' or `tree'.
  582. FORMAT-ENTRY is a function called on each file which should
  583. return a string. Return value is a list as returned by
  584. `org-list-to-lisp'."
  585. (let ((root (expand-file-name
  586. (file-name-as-directory
  587. (org-publish-property :base-directory project)))))
  588. (pcase style
  589. (`list
  590. (cons 'unordered
  591. (mapcar
  592. (lambda (f)
  593. (list (funcall format-entry
  594. (file-relative-name f root)
  595. style
  596. project)))
  597. files)))
  598. (`tree
  599. (letrec ((files-only (cl-remove-if #'directory-name-p files))
  600. (directories (cl-remove-if-not #'directory-name-p files))
  601. (subtree-to-list
  602. (lambda (dir)
  603. (cons 'unordered
  604. (nconc
  605. ;; Files in DIR.
  606. (mapcar
  607. (lambda (f)
  608. (list (funcall format-entry
  609. (file-relative-name f root)
  610. style
  611. project)))
  612. (cl-remove-if-not
  613. (lambda (f) (string= dir (file-name-directory f)))
  614. files-only))
  615. ;; Direct sub-directories.
  616. (mapcar
  617. (lambda (sub)
  618. (list (funcall format-entry
  619. (file-relative-name sub root)
  620. style
  621. project)
  622. (funcall subtree-to-list sub)))
  623. (cl-remove-if-not
  624. (lambda (f)
  625. (string=
  626. dir
  627. ;; Parent directory.
  628. (file-name-directory (directory-file-name f))))
  629. directories)))))))
  630. (funcall subtree-to-list root)))
  631. (_ (user-error "Unknown site-map style: `%s'" style)))))
  632. (defun org-publish-sitemap (project &optional sitemap-filename)
  633. "Create a sitemap of pages in set defined by PROJECT.
  634. Optionally set the filename of the sitemap with SITEMAP-FILENAME.
  635. Default for SITEMAP-FILENAME is `sitemap.org'."
  636. (let* ((root (expand-file-name
  637. (file-name-as-directory
  638. (org-publish-property :base-directory project))))
  639. (sitemap-filename (concat root (or sitemap-filename "sitemap.org")))
  640. (title (or (org-publish-property :sitemap-title project)
  641. (concat "Sitemap for project " (car project))))
  642. (style (or (org-publish-property :sitemap-style project)
  643. 'tree))
  644. (sitemap-builder (or (org-publish-property :sitemap-function project)
  645. #'org-publish-sitemap-default))
  646. (format-entry (or (org-publish-property :sitemap-format-entry project)
  647. #'org-publish-sitemap-default-entry))
  648. (sort-folders
  649. (org-publish-property :sitemap-sort-folders project
  650. org-publish-sitemap-sort-folders))
  651. (sort-files
  652. (org-publish-property :sitemap-sort-files project
  653. org-publish-sitemap-sort-files))
  654. (ignore-case
  655. (org-publish-property :sitemap-ignore-case project
  656. org-publish-sitemap-sort-ignore-case))
  657. (org-file-p (lambda (f) (equal "org" (file-name-extension f))))
  658. (sort-predicate
  659. (lambda (a b)
  660. (let ((retval t))
  661. ;; First we sort files:
  662. (pcase sort-files
  663. (`alphabetically
  664. (let ((A (if (funcall org-file-p a)
  665. (concat (file-name-directory a)
  666. (org-publish-find-title a project))
  667. a))
  668. (B (if (funcall org-file-p b)
  669. (concat (file-name-directory b)
  670. (org-publish-find-title b project))
  671. b)))
  672. (setq retval
  673. (if ignore-case
  674. (not (string-lessp (upcase B) (upcase A)))
  675. (not (string-lessp B A))))))
  676. ((or `anti-chronologically `chronologically)
  677. (let* ((adate (org-publish-find-date a project))
  678. (bdate (org-publish-find-date b project))
  679. (A (+ (lsh (car adate) 16) (cadr adate)))
  680. (B (+ (lsh (car bdate) 16) (cadr bdate))))
  681. (setq retval
  682. (if (eq sort-files 'chronologically)
  683. (<= A B)
  684. (>= A B)))))
  685. (`nil nil)
  686. (_ (user-error "Invalid sort value %s" sort-files)))
  687. ;; Directory-wise wins:
  688. (when (memq sort-folders '(first last))
  689. ;; a is directory, b not:
  690. (cond
  691. ((and (file-directory-p a) (not (file-directory-p b)))
  692. (setq retval (eq sort-folders 'first)))
  693. ;; a is not a directory, but b is:
  694. ((and (not (file-directory-p a)) (file-directory-p b))
  695. (setq retval (eq sort-folders 'last)))))
  696. retval))))
  697. (message "Generating sitemap for %s" title)
  698. (with-temp-file sitemap-filename
  699. (insert
  700. (let ((files (remove sitemap-filename
  701. (org-publish-get-base-files project))))
  702. ;; Add directories, if applicable.
  703. (unless (and (eq style 'list) (eq sort-folders 'ignore))
  704. (setq files
  705. (nconc (remove root (org-uniquify
  706. (mapcar #'file-name-directory files)))
  707. files)))
  708. ;; Eventually sort all entries.
  709. (when (or sort-files (not (memq sort-folders 'ignore)))
  710. (setq files (sort files sort-predicate)))
  711. (funcall sitemap-builder
  712. title
  713. (org-publish--sitemap-files-to-lisp
  714. files project style format-entry)))))))
  715. (defun org-publish-find-property (file property project &optional backend)
  716. "Find the PROPERTY of FILE in project.
  717. PROPERTY is a keyword referring to an export option, as defined
  718. in `org-export-options-alist' or in export back-ends. In the
  719. latter case, optional argument BACKEND has to be set to the
  720. back-end where the option is defined, e.g.,
  721. (org-publish-find-property file :subtitle 'latex)
  722. Return value may be a string or a list, depending on the type of
  723. PROPERTY, i.e. \"behavior\" parameter from `org-export-options-alist'."
  724. (let ((file (org-publish--expand-file-name file project)))
  725. (when (and (file-readable-p file) (not (directory-name-p file)))
  726. (let* ((org-inhibit-startup t)
  727. (visiting (find-buffer-visiting file))
  728. (buffer (or visiting (find-file-noselect file))))
  729. (unwind-protect
  730. (plist-get (with-current-buffer buffer
  731. (if (not visiting) (org-export-get-environment backend)
  732. ;; Protect local variables in open buffers.
  733. (org-export-with-buffer-copy
  734. (org-export-get-environment backend))))
  735. property)
  736. (unless visiting (kill-buffer buffer)))))))
  737. (defun org-publish-find-title (file project)
  738. "Find the title of FILE in PROJECT."
  739. (let ((file (org-publish--expand-file-name file project)))
  740. (or (org-publish-cache-get-file-property file :title nil t)
  741. (let* ((parsed-title (org-publish-find-property file :title project))
  742. (title
  743. (if parsed-title
  744. ;; Remove property so that the return value is
  745. ;; cache-able (i.e., it can be `read' back).
  746. (org-no-properties
  747. (org-element-interpret-data parsed-title))
  748. (file-name-nondirectory (file-name-sans-extension file)))))
  749. (org-publish-cache-set-file-property file :title title)))))
  750. (defun org-publish-find-date (file project)
  751. "Find the date of FILE in PROJECT.
  752. This function assumes FILE is either a directory or an Org file.
  753. If FILE is an Org file and provides a DATE keyword use it. In
  754. any other case use the file system's modification time. Return
  755. time in `current-time' format."
  756. (let ((file (org-publish--expand-file-name file project)))
  757. (or (org-publish-cache-get-file-property file :date nil t)
  758. (org-publish-cache-set-file-property
  759. file :date
  760. (if (file-directory-p file) (nth 5 (file-attributes file))
  761. (let ((date (org-publish-find-property file :date project)))
  762. ;; DATE is a secondary string. If it contains
  763. ;; a time-stamp, convert it to internal format.
  764. ;; Otherwise, use FILE modification time.
  765. (cond ((let ((ts (and (consp date) (assq 'timestamp date))))
  766. (and ts
  767. (let ((value (org-element-interpret-data ts)))
  768. (and (org-string-nw-p value)
  769. (org-time-string-to-time value))))))
  770. ((file-exists-p file) (nth 5 (file-attributes file)))
  771. (t (error "No such file: \"%s\"" file)))))))))
  772. (defun org-publish-sitemap-default-entry (entry style project)
  773. "Default format for site map ENTRY, as a string.
  774. ENTRY is a file name. STYLE is the style of the sitemap.
  775. PROJECT is the current project."
  776. (cond ((not (directory-name-p entry))
  777. (format "[[file:%s][%s]]"
  778. entry
  779. (org-publish-find-title entry project)))
  780. ((eq style 'tree)
  781. ;; Return only last subdir.
  782. (file-name-nondirectory (directory-file-name entry)))
  783. (t entry)))
  784. (defun org-publish-sitemap-default (title list)
  785. "Default site map, as a string.
  786. TITLE is the the title of the site map. LIST is an internal
  787. representation for the files to include, as returned by
  788. `org-list-to-lisp'. PROJECT is the current project."
  789. (concat "#+TITLE: " title "\n\n"
  790. (org-list-to-org list)))
  791. ;;; Interactive publishing functions
  792. ;;;###autoload
  793. (defalias 'org-publish-project 'org-publish)
  794. ;;;###autoload
  795. (defun org-publish (project &optional force async)
  796. "Publish PROJECT.
  797. PROJECT is either a project name, as a string, or a project
  798. alist (see `org-publish-project-alist' variable).
  799. When optional argument FORCE is non-nil, force publishing all
  800. files in PROJECT. With a non-nil optional argument ASYNC,
  801. publishing will be done asynchronously, in another process."
  802. (interactive
  803. (list (assoc (completing-read "Publish project: "
  804. org-publish-project-alist nil t)
  805. org-publish-project-alist)
  806. current-prefix-arg))
  807. (let ((project (if (not (stringp project)) project
  808. ;; If this function is called in batch mode,
  809. ;; PROJECT is still a string here.
  810. (assoc project org-publish-project-alist))))
  811. (cond
  812. ((not project))
  813. (async
  814. (org-export-async-start (lambda (_) nil)
  815. `(let ((org-publish-use-timestamps-flag
  816. ,(and (not force) org-publish-use-timestamps-flag)))
  817. ;; Expand components right now as external process may not
  818. ;; be aware of complete `org-publish-project-alist'.
  819. (org-publish-projects
  820. ',(org-publish-expand-projects (list project))))))
  821. (t (save-window-excursion
  822. (let ((org-publish-use-timestamps-flag
  823. (and (not force) org-publish-use-timestamps-flag)))
  824. (org-publish-projects (list project))))))))
  825. ;;;###autoload
  826. (defun org-publish-all (&optional force async)
  827. "Publish all projects.
  828. With prefix argument FORCE, remove all files in the timestamp
  829. directory and force publishing all projects. With a non-nil
  830. optional argument ASYNC, publishing will be done asynchronously,
  831. in another process."
  832. (interactive "P")
  833. (if async
  834. (org-export-async-start (lambda (_) nil)
  835. `(progn
  836. (when ',force (org-publish-remove-all-timestamps))
  837. (let ((org-publish-use-timestamps-flag
  838. (if ',force nil ,org-publish-use-timestamps-flag)))
  839. (org-publish-projects ',org-publish-project-alist))))
  840. (when force (org-publish-remove-all-timestamps))
  841. (save-window-excursion
  842. (let ((org-publish-use-timestamps-flag
  843. (if force nil org-publish-use-timestamps-flag)))
  844. (org-publish-projects org-publish-project-alist)))))
  845. ;;;###autoload
  846. (defun org-publish-current-file (&optional force async)
  847. "Publish the current file.
  848. With prefix argument FORCE, force publish the file. When
  849. optional argument ASYNC is non-nil, publishing will be done
  850. asynchronously, in another process."
  851. (interactive "P")
  852. (let ((file (buffer-file-name (buffer-base-buffer))))
  853. (if async
  854. (org-export-async-start (lambda (_) nil)
  855. `(let ((org-publish-use-timestamps-flag
  856. (if ',force nil ,org-publish-use-timestamps-flag)))
  857. (org-publish-file ,file)))
  858. (save-window-excursion
  859. (let ((org-publish-use-timestamps-flag
  860. (if force nil org-publish-use-timestamps-flag)))
  861. (org-publish-file file))))))
  862. ;;;###autoload
  863. (defun org-publish-current-project (&optional force async)
  864. "Publish the project associated with the current file.
  865. With a prefix argument, force publishing of all files in
  866. the project."
  867. (interactive "P")
  868. (save-window-excursion
  869. (let ((project (org-publish-get-project-from-filename
  870. (buffer-file-name (buffer-base-buffer)) 'up)))
  871. (if project (org-publish project force async)
  872. (error "File %s is not part of any known project"
  873. (buffer-file-name (buffer-base-buffer)))))))
  874. ;;; Index generation
  875. (defun org-publish-collect-index (output _backend info)
  876. "Update index for a file in cache.
  877. OUTPUT is the output from transcoding current file. BACKEND is
  878. the back-end that was used for transcoding. INFO is a plist
  879. containing publishing and export options.
  880. The index relative to current file is stored as an alist. An
  881. association has the following shape: (TERM FILE-NAME PARENT),
  882. where TERM is the indexed term, as a string, FILE-NAME is the
  883. original full path of the file where the term in encountered, and
  884. PARENT is a reference to the headline, if any, containing the
  885. original index keyword. When non-nil, this reference is a cons
  886. cell. Its CAR is a symbol among `id', `custom-id' and `name' and
  887. its CDR is a string."
  888. (let ((file (file-truename (plist-get info :input-file))))
  889. (org-publish-cache-set-file-property
  890. file :index
  891. (delete-dups
  892. (org-element-map (plist-get info :parse-tree) 'keyword
  893. (lambda (k)
  894. (when (equal (org-element-property :key k) "INDEX")
  895. (let ((parent (org-export-get-parent-headline k)))
  896. (list (org-element-property :value k)
  897. file
  898. (cond
  899. ((not parent) nil)
  900. ((let ((id (org-element-property :ID parent)))
  901. (and id (cons 'id id))))
  902. ((let ((id (org-element-property :CUSTOM_ID parent)))
  903. (and id (cons 'custom-id id))))
  904. (t (cons 'name
  905. ;; Remove statistics cookie.
  906. (replace-regexp-in-string
  907. "\\[[0-9]+%\\]\\|\\[[0-9]+/[0-9]+\\]" ""
  908. (org-element-property :raw-value parent)))))))))
  909. info))))
  910. ;; Return output unchanged.
  911. output)
  912. (defun org-publish-index-generate-theindex (project directory)
  913. "Retrieve full index from cache and build \"theindex.org\".
  914. PROJECT is the project the index relates to. DIRECTORY is the
  915. publishing directory."
  916. (let ((all-files (org-publish-get-base-files project))
  917. full-index)
  918. ;; Compile full index and sort it alphabetically.
  919. (dolist (file all-files
  920. (setq full-index
  921. (sort (nreverse full-index)
  922. (lambda (a b) (string< (downcase (car a))
  923. (downcase (car b)))))))
  924. (let ((index (org-publish-cache-get-file-property file :index)))
  925. (dolist (term index)
  926. (unless (member term full-index) (push term full-index)))))
  927. ;; Write "theindex.inc" in DIRECTORY.
  928. (with-temp-file (expand-file-name "theindex.inc" directory)
  929. (let ((current-letter nil) (last-entry nil))
  930. (dolist (idx full-index)
  931. (let* ((entry (org-split-string (car idx) "!"))
  932. (letter (upcase (substring (car entry) 0 1)))
  933. ;; Transform file into a path relative to publishing
  934. ;; directory.
  935. (file (file-relative-name
  936. (nth 1 idx)
  937. (plist-get (cdr project) :base-directory))))
  938. ;; Check if another letter has to be inserted.
  939. (unless (string= letter current-letter)
  940. (insert (format "* %s\n" letter)))
  941. ;; Compute the first difference between last entry and
  942. ;; current one: it tells the level at which new items
  943. ;; should be added.
  944. (let* ((rank
  945. (if (equal entry last-entry) (1- (length entry))
  946. (cl-loop for n from 0 to (length entry)
  947. unless (equal (nth n entry) (nth n last-entry))
  948. return n)))
  949. (len (length (nthcdr rank entry))))
  950. ;; For each term after the first difference, create
  951. ;; a new sub-list with the term as body. Moreover,
  952. ;; linkify the last term.
  953. (dotimes (n len)
  954. (insert
  955. (concat
  956. (make-string (* (+ rank n) 2) ?\s) " - "
  957. (if (not (= (1- len) n)) (nth (+ rank n) entry)
  958. ;; Last term: Link it to TARGET, if possible.
  959. (let ((target (nth 2 idx)))
  960. (format
  961. "[[%s][%s]]"
  962. ;; Destination.
  963. (pcase (car target)
  964. (`nil (format "file:%s" file))
  965. (`id (format "id:%s" (cdr target)))
  966. (`custom-id (format "file:%s::#%s" file (cdr target)))
  967. (_ (format "file:%s::*%s" file (cdr target))))
  968. ;; Description.
  969. (car (last entry)))))
  970. "\n"))))
  971. (setq current-letter letter last-entry entry))))
  972. ;; Create "theindex.org", if it doesn't exist yet, and provide
  973. ;; a default index file.
  974. (let ((index.org (expand-file-name "theindex.org" directory)))
  975. (unless (file-exists-p index.org)
  976. (with-temp-file index.org
  977. (insert "#+TITLE: Index\n\n#+INCLUDE: \"theindex.inc\"\n\n")))))))
  978. ;;; External Fuzzy Links Resolution
  979. ;;
  980. ;; This part implements tools to resolve [[file.org::*Some headline]]
  981. ;; links, where "file.org" belongs to the current project.
  982. (defun org-publish--store-crossrefs (output _backend info)
  983. "Store cross-references for current published file.
  984. OUTPUT is the produced output, as a string. BACKEND is the export
  985. back-end used, as a symbol. INFO is the final export state, as
  986. a plist.
  987. This function is meant to be used as a final output filter. See
  988. `org-publish-org-to'."
  989. (org-publish-cache-set-file-property
  990. (file-truename (plist-get info :input-file))
  991. :crossrefs
  992. ;; Update `:crossrefs' so as to remove unused references and search
  993. ;; cells. Actually used references are extracted from
  994. ;; `:internal-references', with references as strings removed. See
  995. ;; `org-export-get-reference' for details.
  996. (cl-remove-if (lambda (pair) (stringp (car pair)))
  997. (plist-get info :internal-references)))
  998. ;; Return output unchanged.
  999. output)
  1000. (defun org-publish-resolve-external-link (search file &optional prefer-custom)
  1001. "Return reference for element matching string SEARCH in FILE.
  1002. Return value is an internal reference, as a string.
  1003. This function allows resolving external links with a search
  1004. option, e.g.,
  1005. [[file:file.org::*heading][description]]
  1006. [[file:file.org::#custom-id][description]]
  1007. [[file:file.org::fuzzy][description]]
  1008. When PREFER-CUSTOM is non-nil, and SEARCH targets a headline in
  1009. FILE, return its custom ID, if any.
  1010. It only makes sense to use this if export back-end builds
  1011. references with `org-export-get-reference'."
  1012. (cond
  1013. ((and prefer-custom
  1014. (if (string-prefix-p "#" search)
  1015. (substring search 1)
  1016. (with-current-buffer (find-file-noselect file)
  1017. (org-with-point-at 1
  1018. (let ((org-link-search-must-match-exact-headline t))
  1019. (org-link-search (org-link-unescape search) nil t))
  1020. (and (org-at-heading-p)
  1021. (org-string-nw-p (org-entry-get (point) "CUSTOM_ID"))))))))
  1022. ((not org-publish-cache)
  1023. (progn
  1024. (message "Reference %S in file %S cannot be resolved without publishing"
  1025. search
  1026. file)
  1027. "MissingReference"))
  1028. (t
  1029. (let* ((filename (file-truename file))
  1030. (crossrefs
  1031. (org-publish-cache-get-file-property filename :crossrefs nil t))
  1032. (cells
  1033. (org-export-string-to-search-cell (org-link-unescape search))))
  1034. (or
  1035. ;; Look for reference associated to search cells triggered by
  1036. ;; LINK. It can match when targeted file has been published
  1037. ;; already.
  1038. (let ((known (cdr (cl-some (lambda (c) (assoc c crossrefs)) cells))))
  1039. (and known (org-export-format-reference known)))
  1040. ;; Search cell is unknown so far. Generate a new internal
  1041. ;; reference that will be used when the targeted file will be
  1042. ;; published.
  1043. (let ((new (org-export-new-reference crossrefs)))
  1044. (dolist (cell cells) (push (cons cell new) crossrefs))
  1045. (org-publish-cache-set-file-property filename :crossrefs crossrefs)
  1046. (org-export-format-reference new)))))))
  1047. (defun org-publish-file-relative-name (filename info)
  1048. "Convert FILENAME to be relative to current project's base directory.
  1049. INFO is the plist containing the current export state. The
  1050. function does not change relative file names."
  1051. (let ((base (plist-get info :base-directory)))
  1052. (if (and base
  1053. (file-name-absolute-p filename)
  1054. (file-in-directory-p filename base))
  1055. (file-relative-name filename base)
  1056. filename)))
  1057. ;;; Caching functions
  1058. (defun org-publish-write-cache-file (&optional free-cache)
  1059. "Write `org-publish-cache' to file.
  1060. If FREE-CACHE, empty the cache."
  1061. (unless org-publish-cache
  1062. (error "`org-publish-write-cache-file' called, but no cache present"))
  1063. (let ((cache-file (org-publish-cache-get ":cache-file:")))
  1064. (unless cache-file
  1065. (error "Cannot find cache-file name in `org-publish-write-cache-file'"))
  1066. (with-temp-file cache-file
  1067. (let (print-level print-length)
  1068. (insert "(setq org-publish-cache \
  1069. \(make-hash-table :test 'equal :weakness nil :size 100))\n")
  1070. (maphash (lambda (k v)
  1071. (insert
  1072. (format "(puthash %S %s%S org-publish-cache)\n"
  1073. k (if (or (listp v) (symbolp v)) "'" "") v)))
  1074. org-publish-cache)))
  1075. (when free-cache (org-publish-reset-cache))))
  1076. (defun org-publish-initialize-cache (project-name)
  1077. "Initialize the projects cache if not initialized yet and return it."
  1078. (unless project-name
  1079. (error "Cannot initialize `org-publish-cache' without projects name in \
  1080. `org-publish-initialize-cache'"))
  1081. (unless (file-exists-p org-publish-timestamp-directory)
  1082. (make-directory org-publish-timestamp-directory t))
  1083. (unless (file-directory-p org-publish-timestamp-directory)
  1084. (error "Org publish timestamp: %s is not a directory"
  1085. org-publish-timestamp-directory))
  1086. (unless (and org-publish-cache
  1087. (string= (org-publish-cache-get ":project:") project-name))
  1088. (let* ((cache-file
  1089. (concat
  1090. (expand-file-name org-publish-timestamp-directory)
  1091. project-name ".cache"))
  1092. (cexists (file-exists-p cache-file)))
  1093. (when org-publish-cache (org-publish-reset-cache))
  1094. (if cexists (load-file cache-file)
  1095. (setq org-publish-cache
  1096. (make-hash-table :test 'equal :weakness nil :size 100))
  1097. (org-publish-cache-set ":project:" project-name)
  1098. (org-publish-cache-set ":cache-file:" cache-file))
  1099. (unless cexists (org-publish-write-cache-file nil))))
  1100. org-publish-cache)
  1101. (defun org-publish-reset-cache ()
  1102. "Empty org-publish-cache and reset it nil."
  1103. (message "%s" "Resetting org-publish-cache")
  1104. (when (hash-table-p org-publish-cache)
  1105. (clrhash org-publish-cache))
  1106. (setq org-publish-cache nil))
  1107. (defun org-publish-cache-file-needs-publishing
  1108. (filename &optional pub-dir pub-func _base-dir)
  1109. "Check the timestamp of the last publishing of FILENAME.
  1110. Return non-nil if the file needs publishing. Also check if
  1111. any included files have been more recently published, so that
  1112. the file including them will be republished as well."
  1113. (unless org-publish-cache
  1114. (error
  1115. "`org-publish-cache-file-needs-publishing' called, but no cache present"))
  1116. (let* ((key (org-publish-timestamp-filename filename pub-dir pub-func))
  1117. (pstamp (org-publish-cache-get key))
  1118. (org-inhibit-startup t)
  1119. included-files-ctime)
  1120. (when (equal (file-name-extension filename) "org")
  1121. (let ((visiting (find-buffer-visiting filename))
  1122. (buf (find-file-noselect filename))
  1123. (case-fold-search t))
  1124. (unwind-protect
  1125. (with-current-buffer buf
  1126. (goto-char (point-min))
  1127. (while (re-search-forward "^[ \t]*#\\+INCLUDE:" nil t)
  1128. (let ((element (org-element-at-point)))
  1129. (when (eq 'keyword (org-element-type element))
  1130. (let* ((value (org-element-property :value element))
  1131. (filename
  1132. (and (string-match "\\`\\(\".+?\"\\|\\S-+\\)" value)
  1133. (let ((m (org-unbracket-string
  1134. "\"" "\"" (match-string 1 value))))
  1135. ;; Ignore search suffix.
  1136. (if (string-match "::.*?\\'" m)
  1137. (substring m 0 (match-beginning 0))
  1138. m)))))
  1139. (when filename
  1140. (push (org-publish-cache-ctime-of-src
  1141. (expand-file-name filename))
  1142. included-files-ctime)))))))
  1143. (unless visiting (kill-buffer buf)))))
  1144. (or (null pstamp)
  1145. (let ((ctime (org-publish-cache-ctime-of-src filename)))
  1146. (or (< pstamp ctime)
  1147. (cl-some (lambda (ct) (< ctime ct)) included-files-ctime))))))
  1148. (defun org-publish-cache-set-file-property
  1149. (filename property value &optional project-name)
  1150. "Set the VALUE for a PROPERTY of file FILENAME in publishing cache to VALUE.
  1151. Use cache file of PROJECT-NAME. If the entry does not exist, it
  1152. will be created. Return VALUE."
  1153. ;; Evtl. load the requested cache file:
  1154. (when project-name (org-publish-initialize-cache project-name))
  1155. (let ((pl (org-publish-cache-get filename)))
  1156. (if pl (progn (plist-put pl property value) value)
  1157. (org-publish-cache-get-file-property
  1158. filename property value nil project-name))))
  1159. (defun org-publish-cache-get-file-property
  1160. (filename property &optional default no-create project-name)
  1161. "Return the value for a PROPERTY of file FILENAME in publishing cache.
  1162. Use cache file of PROJECT-NAME. Return the value of that PROPERTY,
  1163. or DEFAULT, if the value does not yet exist. Create the entry,
  1164. if necessary, unless NO-CREATE is non-nil."
  1165. (when project-name (org-publish-initialize-cache project-name))
  1166. (let ((properties (org-publish-cache-get filename)))
  1167. (cond ((null properties)
  1168. (unless no-create
  1169. (org-publish-cache-set filename (list property default)))
  1170. default)
  1171. ((plist-member properties property) (plist-get properties property))
  1172. (t default))))
  1173. (defun org-publish-cache-get (key)
  1174. "Return the value stored in `org-publish-cache' for key KEY.
  1175. Return nil, if no value or nil is found. Raise an error if the
  1176. cache does not exist."
  1177. (unless org-publish-cache
  1178. (error "`org-publish-cache-get' called, but no cache present"))
  1179. (gethash key org-publish-cache))
  1180. (defun org-publish-cache-set (key value)
  1181. "Store KEY VALUE pair in `org-publish-cache'.
  1182. Returns value on success, else nil. Raise an error if the cache
  1183. does not exist."
  1184. (unless org-publish-cache
  1185. (error "`org-publish-cache-set' called, but no cache present"))
  1186. (puthash key value org-publish-cache))
  1187. (defun org-publish-cache-ctime-of-src (file)
  1188. "Get the ctime of FILE as an integer."
  1189. (let ((attr (file-attributes
  1190. (expand-file-name (or (file-symlink-p file) file)
  1191. (file-name-directory file)))))
  1192. (if (not attr) (error "No such file: \"%s\"" file)
  1193. (+ (lsh (car (nth 5 attr)) 16)
  1194. (cadr (nth 5 attr))))))
  1195. (provide 'ox-publish)
  1196. ;; Local variables:
  1197. ;; generated-autoload-file: "org-loaddefs.el"
  1198. ;; End:
  1199. ;;; ox-publish.el ends here