ox-publish.el 50 KB

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