test-ox-publish.el 18 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546
  1. ;;; test-ox-publish.el --- Tests for "ox-publish.el" -*- lexical-binding: t; -*-
  2. ;; Copyright (C) 2016 Nicolas Goaziou
  3. ;; Author: Nicolas Goaziou <mail@nicolasgoaziou.fr>
  4. ;; This program is free software; you can redistribute it and/or modify
  5. ;; it under the terms of the GNU General Public License as published by
  6. ;; the Free Software Foundation, either version 3 of the License, or
  7. ;; (at your option) any later version.
  8. ;; This program is distributed in the hope that it will be useful,
  9. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  11. ;; GNU General Public License for more details.
  12. ;; You should have received a copy of the GNU General Public License
  13. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  14. ;;; Code:
  15. ;;; Helper functions
  16. (defun org-test-publish (properties handler)
  17. "Publish a project defined by PROPERTIES.
  18. Call HANDLER with the publishing directory as its sole argument.
  19. Unless set otherwise in PROPERTIES, `:base-directory' is set to
  20. \"examples/pub/\" sub-directory from test directory and
  21. `:publishing-function' is set to `org-publish-attachment'."
  22. (declare (indent 1))
  23. (let* ((org-publish-use-timestamps-flag nil)
  24. (org-publish-cache nil)
  25. (base-dir (expand-file-name "examples/pub/" org-test-dir))
  26. (pub-dir (make-temp-file "org-test" t))
  27. (org-publish-timestamp-directory
  28. (expand-file-name ".org-timestamps/" pub-dir))
  29. (project
  30. `("test" ,@(org-combine-plists
  31. `(:base-directory
  32. ,base-dir
  33. :publishing-function org-publish-attachment)
  34. properties
  35. `(:publishing-directory ,pub-dir)))))
  36. (unwind-protect
  37. (progn
  38. (org-publish-projects (list project))
  39. (funcall handler pub-dir))
  40. ;; Clear published data.
  41. (delete-directory pub-dir t)
  42. ;; Delete auto-generated site-map file, if applicable.
  43. (let ((site-map (and (plist-get properties :auto-sitemap)
  44. (expand-file-name
  45. (or (plist-get properties :sitemap-filename)
  46. "sitemap.org")
  47. base-dir))))
  48. (when (and site-map (file-exists-p site-map))
  49. (delete-file site-map))))))
  50. ;;; Mandatory properties
  51. (ert-deftest test-org-publish/base-extension ()
  52. "Test `:base-extension' specifications"
  53. ;; Regular tests.
  54. (should
  55. (equal '("a.org" "b.org")
  56. (org-test-publish '(:base-extension "org")
  57. (lambda (dir)
  58. (remove ".org-timestamps"
  59. (cl-remove-if #'file-directory-p
  60. (directory-files dir)))))))
  61. (should
  62. (equal '("file.txt")
  63. (org-test-publish '(:base-extension "txt")
  64. (lambda (dir)
  65. (remove ".org-timestamps"
  66. (cl-remove-if #'file-directory-p
  67. (directory-files dir)))))))
  68. ;; A nil value is equivalent to ".org".
  69. (should
  70. (equal '("a.org" "b.org")
  71. (org-test-publish '(:base-extension nil)
  72. (lambda (dir)
  73. (remove ".org-timestamps"
  74. (cl-remove-if #'file-directory-p
  75. (directory-files dir)))))))
  76. ;; Symbol `any' includes all files, even those without extension.
  77. (should
  78. (equal '("a.org" "b.org" "file.txt" "noextension")
  79. (org-test-publish '(:base-extension any)
  80. (lambda (dir)
  81. (remove ".org-timestamps"
  82. (cl-remove-if #'file-directory-p
  83. (directory-files dir))))))))
  84. ;;; Site-map
  85. (ert-deftest test-org-publish/sitemap ()
  86. "Test site-map specifications."
  87. ;; Site-map creation is controlled with `:auto-sitemap'. It
  88. ;; defaults to "sitemap.org".
  89. (should
  90. (org-test-publish
  91. '(:auto-sitemap t)
  92. (lambda (dir) (file-exists-p (expand-file-name "sitemap.org" dir)))))
  93. (should-not
  94. (org-test-publish
  95. '(:auto-sitemap nil)
  96. (lambda (dir) (file-exists-p (expand-file-name "sitemap.org" dir)))))
  97. ;; Site-map file name is controlled with `:sitemap-filename'.
  98. (should
  99. (org-test-publish
  100. '(:auto-sitemap t :sitemap-filename "mysitemap.org")
  101. (lambda (dir) (file-exists-p (expand-file-name "mysitemap.org" dir)))))
  102. ;; Site-map title is controlled with `:sitemap-title'. It defaults
  103. ;; to the project name.
  104. (should
  105. (equal "#+TITLE: Sitemap for project test"
  106. (org-test-publish
  107. '(:auto-sitemap t)
  108. (lambda (dir)
  109. (with-temp-buffer
  110. (insert-file-contents (expand-file-name "sitemap.org" dir))
  111. (buffer-substring (point) (line-end-position)))))))
  112. (should
  113. (equal "#+TITLE: My title"
  114. (org-test-publish
  115. '(:auto-sitemap t :sitemap-title "My title")
  116. (lambda (dir)
  117. (with-temp-buffer
  118. (insert-file-contents (expand-file-name "sitemap.org" dir))
  119. (buffer-substring (point) (line-end-position)))))))
  120. ;; Allowed site-map styles: `list' and `tree'.
  121. (should
  122. (equal "
  123. - [[file:a.org][A]]
  124. - [[file:b.org][b]]
  125. - [[file:sub/c.org][C]]"
  126. (org-test-publish
  127. '(:auto-sitemap t
  128. :sitemap-sort-folders ignore
  129. :sitemap-style list
  130. :exclude "."
  131. :include ("a.org" "b.org" "sub/c.org"))
  132. (lambda (dir)
  133. (with-temp-buffer
  134. (insert-file-contents (expand-file-name "sitemap.org" dir))
  135. (buffer-substring (line-beginning-position 2) (point-max)))))))
  136. (should
  137. (equal "
  138. - [[file:a.org][A]]
  139. - [[file:b.org][b]]
  140. - sub
  141. - [[file:sub/c.org][C]]"
  142. (org-test-publish
  143. '(:auto-sitemap t
  144. :sitemap-style tree
  145. :exclude "."
  146. :include ("a.org" "b.org" "sub/c.org"))
  147. (lambda (dir)
  148. (with-temp-buffer
  149. (insert-file-contents (expand-file-name "sitemap.org" dir))
  150. (buffer-substring (line-beginning-position 2) (point-max)))))))
  151. ;; When style is `list', `:sitemap-sort-folders' controls the order
  152. ;; of appearance of directories among published files.
  153. (should
  154. (equal
  155. "
  156. - sub/
  157. - [[file:a.org][A]]
  158. - [[file:sub/c.org][C]]"
  159. (org-test-publish
  160. '(:auto-sitemap t
  161. :recursive t
  162. :sitemap-style list
  163. :sitemap-sort-folders first
  164. :exclude "."
  165. :include ("a.org" "sub/c.org"))
  166. (lambda (dir)
  167. (with-temp-buffer
  168. (insert-file-contents (expand-file-name "sitemap.org" dir))
  169. (buffer-substring (line-beginning-position 2) (point-max)))))))
  170. (should
  171. (equal
  172. "
  173. - [[file:a.org][A]]
  174. - [[file:sub/c.org][C]]
  175. - sub/"
  176. (org-test-publish
  177. '(:auto-sitemap t
  178. :recursive t
  179. :sitemap-style list
  180. :sitemap-sort-folders last
  181. :exclude "."
  182. :include ("a.org" "sub/c.org"))
  183. (lambda (dir)
  184. (with-temp-buffer
  185. (insert-file-contents (expand-file-name "sitemap.org" dir))
  186. (buffer-substring (line-beginning-position 2) (point-max)))))))
  187. ;; When style is `list', `:sitemap-sort-folders' can be used to
  188. ;; toggle visibility of directories in the site-map.
  189. (should
  190. (let ((case-fold-search t))
  191. (string-match-p
  192. "- sub/$"
  193. (org-test-publish
  194. '(:auto-sitemap t
  195. :recursive t
  196. :sitemap-style list
  197. :sitemap-sort-folders t
  198. :exclude "."
  199. :include ("a.org" "sub/c.org"))
  200. (lambda (dir)
  201. (with-temp-buffer
  202. (insert-file-contents (expand-file-name "sitemap.org" dir))
  203. (buffer-substring (line-beginning-position 2) (point-max))))))))
  204. (should-not
  205. (string-match-p
  206. "- sub/$"
  207. (org-test-publish
  208. '(:auto-sitemap t
  209. :recursive t
  210. :sitemap-style list
  211. :sitemap-sort-folders ignore
  212. :exclude "."
  213. :include ("a.org" "sub/c.org"))
  214. (lambda (dir)
  215. (with-temp-buffer
  216. (insert-file-contents (expand-file-name "sitemap.org" dir))
  217. (buffer-substring (line-beginning-position 2) (point-max)))))))
  218. ;; Using `:sitemap-sort-files', files can be sorted alphabetically
  219. ;; (according to their title, or file name when there is none),
  220. ;; chronologically a anti-chronologically.
  221. (should
  222. (equal
  223. "
  224. - [[file:a.org][A]]
  225. - [[file:b.org][b]]
  226. - [[file:sub/c.org][C]]"
  227. (org-test-publish
  228. '(:auto-sitemap t
  229. :recursive t
  230. :sitemap-style list
  231. :sitemap-sort-folders ignore
  232. :sitemap-sort-files alphabetically
  233. :exclude "."
  234. :include ("a.org" "b.org" "sub/c.org"))
  235. (lambda (dir)
  236. (with-temp-buffer
  237. (insert-file-contents (expand-file-name "sitemap.org" dir))
  238. (buffer-substring (line-beginning-position 2) (point-max)))))))
  239. (should
  240. (equal
  241. "
  242. - [[file:b.org][b]]
  243. - [[file:sub/c.org][C]]
  244. - [[file:a.org][A]]"
  245. (org-test-publish
  246. '(:auto-sitemap t
  247. :recursive t
  248. :sitemap-style list
  249. :sitemap-sort-folders ignore
  250. :sitemap-sort-files chronologically
  251. :exclude "."
  252. :include ("a.org" "b.org" "sub/c.org"))
  253. (lambda (dir)
  254. (with-temp-buffer
  255. (insert-file-contents (expand-file-name "sitemap.org" dir))
  256. (buffer-substring (line-beginning-position 2) (point-max)))))))
  257. (should
  258. (equal
  259. "
  260. - [[file:a.org][A]]
  261. - [[file:sub/c.org][C]]
  262. - [[file:b.org][b]]"
  263. (org-test-publish
  264. '(:auto-sitemap t
  265. :recursive t
  266. :sitemap-style list
  267. :sitemap-sort-folders ignore
  268. :sitemap-sort-files anti-chronologically
  269. :exclude "."
  270. :include ("a.org" "b.org" "sub/c.org"))
  271. (lambda (dir)
  272. (with-temp-buffer
  273. (insert-file-contents (expand-file-name "sitemap.org" dir))
  274. (buffer-substring (line-beginning-position 2) (point-max)))))))
  275. ;; `:sitemap-format-entry' formats entries in the site-map whereas
  276. ;; `:sitemap-function' controls the full site-map.
  277. (should
  278. (equal "
  279. - a.org"
  280. (org-test-publish
  281. '(:auto-sitemap t
  282. :exclude "."
  283. :include ("a.org")
  284. :sitemap-format-entry
  285. (lambda (f _s _p) f))
  286. (lambda (dir)
  287. (with-temp-buffer
  288. (insert-file-contents (expand-file-name "sitemap.org" dir))
  289. (buffer-substring (line-beginning-position 2) (point-max)))))))
  290. (should
  291. (equal "Custom!"
  292. (org-test-publish
  293. '(:auto-sitemap t
  294. :exclude "."
  295. :include ("a.org")
  296. :sitemap-function (lambda (_title _f) "Custom!"))
  297. (lambda (dir)
  298. (with-temp-buffer
  299. (insert-file-contents (expand-file-name "sitemap.org" dir))
  300. (buffer-string))))))
  301. (should
  302. (equal "[[file:a.org][A]]"
  303. (org-test-publish
  304. '(:auto-sitemap t
  305. :exclude "."
  306. :include ("a.org")
  307. :sitemap-function
  308. (lambda (_title f) (org-list-to-generic f nil)))
  309. (lambda (dir)
  310. (with-temp-buffer
  311. (insert-file-contents (expand-file-name "sitemap.org" dir))
  312. (buffer-string)))))))
  313. ;;; Cross references
  314. (ert-deftest test-org-publish/resolve-external-link ()
  315. "Test `org-publish-resolve-external-link' specifications."
  316. ;; Function should preserve internal reference when used between
  317. ;; published files.
  318. (should
  319. (apply
  320. #'equal
  321. (let* ((ids nil)
  322. (backend
  323. (org-export-create-backend
  324. :transcoders
  325. '((headline . (lambda (h c i)
  326. (concat (org-export-get-reference h i) " " c)))
  327. (paragraph . (lambda (p c i) c))
  328. (section . (lambda (s c i) c))
  329. (link . (lambda (l c i)
  330. (let ((option (org-element-property :search-option l))
  331. (path (org-element-property :path l)))
  332. (and option
  333. (org-publish-resolve-external-link
  334. option path))))))))
  335. (publish
  336. (lambda (plist filename pub-dir)
  337. (org-publish-org-to backend filename ".test" plist pub-dir))))
  338. (org-test-publish
  339. (list :publishing-function (list publish))
  340. (lambda (dir)
  341. (cl-subseq
  342. (split-string
  343. (mapconcat (lambda (f) (org-file-contents (expand-file-name f dir)))
  344. (directory-files dir nil "\\.test\\'")
  345. " "))
  346. 1 3))))))
  347. ;; When optional argument PREFER-CUSTOM is non-nil, use custom ID
  348. ;; instead of internal reference, whenever possible.
  349. (should
  350. (equal
  351. '("a1" "b1")
  352. (let* ((ids nil)
  353. (link-transcoder
  354. (lambda (l c i)
  355. (let ((option (org-element-property :search-option l))
  356. (path (org-element-property :path l)))
  357. (push (org-publish-resolve-external-link option path t)
  358. ids)
  359. "")))
  360. (backend
  361. (org-export-create-backend
  362. :transcoders `((headline . (lambda (h c i) c))
  363. (paragraph . (lambda (p c i) c))
  364. (section . (lambda (s c i) c))
  365. (link . ,link-transcoder))))
  366. (publish
  367. (lambda (plist filename pub-dir)
  368. (org-publish-org-to backend filename ".test" plist pub-dir))))
  369. (org-test-publish (list :publishing-function (list publish)
  370. :exclude "."
  371. :include '("a.org" "b.org"))
  372. #'ignore)
  373. (sort ids #'string<)))))
  374. ;;; Tools
  375. (ert-deftest test-org-publish/get-project-from-filename ()
  376. "Test `org-publish-get-project-from-filename' specifications."
  377. ;; Check base directory.
  378. (should
  379. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  380. (file (expand-file-name "a.org" base))
  381. (org-publish-project-alist `(("p" :base-directory ,base))))
  382. (org-publish-get-project-from-filename file)))
  383. ;; Return nil if no appropriate project is found.
  384. (should-not
  385. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  386. (file (expand-file-name "a.org" base))
  387. (org-publish-project-alist `(("p" :base-directory ,base))))
  388. (org-publish-get-project-from-filename "/other/file.org")))
  389. ;; Return the first project effectively publishing the provided
  390. ;; file.
  391. (should
  392. (equal "p2"
  393. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  394. (file (expand-file-name "a.org" base))
  395. (org-publish-project-alist
  396. `(("p1" :base-directory "/other/")
  397. ("p2" :base-directory ,base))))
  398. (car (org-publish-get-project-from-filename file)))))
  399. ;; When :recursive in non-nil, allow files in sub-directories.
  400. (should
  401. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  402. (file (expand-file-name "sub/c.org" base))
  403. (org-publish-project-alist
  404. `(("p" :base-directory ,base :recursive t))))
  405. (org-publish-get-project-from-filename file)))
  406. (should-not
  407. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  408. (file (expand-file-name "sub/c.org" base))
  409. (org-publish-project-alist
  410. `(("p" :base-directory ,base :recursive nil))))
  411. (org-publish-get-project-from-filename file)))
  412. ;; Check :base-extension.
  413. (should
  414. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  415. (file (expand-file-name "file.txt" base))
  416. (org-publish-project-alist
  417. `(("p" :base-directory ,base :base-extension "txt"))))
  418. (org-publish-get-project-from-filename file)))
  419. (should-not
  420. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  421. (file (expand-file-name "file.txt" base))
  422. (org-publish-project-alist
  423. `(("p" :base-directory ,base :base-extension "org"))))
  424. (org-publish-get-project-from-filename file)))
  425. ;; When :base-extension has the special value `any', allow any
  426. ;; extension, including none.
  427. (should
  428. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  429. (file (expand-file-name "file.txt" base))
  430. (org-publish-project-alist
  431. `(("p" :base-directory ,base :base-extension any))))
  432. (org-publish-get-project-from-filename file)))
  433. (should
  434. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  435. (file (expand-file-name "noextension" base))
  436. (org-publish-project-alist
  437. `(("p" :base-directory ,base :base-extension any))))
  438. (org-publish-get-project-from-filename file)))
  439. ;; Pathological case: Handle both :extension any and :recursive t.
  440. (should
  441. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  442. (file (expand-file-name "sub/c.org" base))
  443. (org-publish-project-alist
  444. `(("p" :base-directory ,base :recursive t :base-extension any))))
  445. (org-publish-get-base-files (org-publish-get-project-from-filename file))))
  446. ;; Check :exclude property.
  447. (should-not
  448. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  449. (file (expand-file-name "a.org" base))
  450. (org-publish-project-alist
  451. `(("p" :base-directory ,base :exclude "a"))))
  452. (org-publish-get-project-from-filename file)))
  453. (should
  454. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  455. (file (expand-file-name "a.org" base))
  456. (org-publish-project-alist
  457. `(("p" :base-directory ,base :exclude "other"))))
  458. (org-publish-get-project-from-filename file)))
  459. ;; The regexp matches against relative file name, not absolute one.
  460. (should
  461. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  462. (file (expand-file-name "a.org" base))
  463. (org-publish-project-alist
  464. `(("p" :base-directory ,base :exclude "examples/pub"))))
  465. (org-publish-get-project-from-filename file)))
  466. ;; Check :include property.
  467. (should
  468. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  469. (file (expand-file-name "file.txt" base))
  470. (org-publish-project-alist
  471. `(("p" :base-directory ,base :include (,file)))))
  472. (org-publish-get-project-from-filename file)))
  473. ;; :include property has precedence over :exclude one.
  474. (should
  475. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  476. (file (expand-file-name "a.org" base))
  477. (org-publish-project-alist
  478. `(("p"
  479. :base-directory ,base
  480. :include (,(file-name-nondirectory file))
  481. :exclude "a"))))
  482. (org-publish-get-project-from-filename file)))
  483. ;; With optional argument, return a meta-project publishing provided
  484. ;; file.
  485. (should
  486. (equal "meta"
  487. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  488. (file (expand-file-name "a.org" base))
  489. (org-publish-project-alist
  490. `(("meta" :components ("p"))
  491. ("p" :base-directory ,base))))
  492. (car (org-publish-get-project-from-filename file t))))))
  493. (ert-deftest test-org-publish/file-relative-name ()
  494. "Test `org-publish-file-relative-name' specifications."
  495. ;; Turn absolute file names into relative ones if file belongs to
  496. ;; base directory.
  497. (should
  498. (equal "a.org"
  499. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  500. (file (expand-file-name "a.org" base)))
  501. (org-publish-file-relative-name file `(:base-directory ,base)))))
  502. (should
  503. (equal "pub/a.org"
  504. (let* ((base (expand-file-name "examples/" org-test-dir))
  505. (file (expand-file-name "pub/a.org" base)))
  506. (org-publish-file-relative-name file `(:base-directory ,base)))))
  507. ;; Absolute file names that do not belong to base directory are
  508. ;; unchanged.
  509. (should
  510. (equal "/name.org"
  511. (let ((base (expand-file-name "examples/pub/" org-test-dir)))
  512. (org-publish-file-relative-name "/name.org"
  513. `(:base-directory ,base)))))
  514. ;; Relative file names are unchanged.
  515. (should
  516. (equal "a.org"
  517. (let ((base (expand-file-name "examples/pub/" org-test-dir)))
  518. (org-publish-file-relative-name "a.org" `(:base-directory ,base))))))
  519. (provide 'test-ox-publish)
  520. ;;; test-ox-publish.el ends here