ox-publish.el 49 KB

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