test-ox-publish.el 17 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496
  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. ;;; Tools
  314. (ert-deftest test-org-publish/get-project-from-filename ()
  315. "Test `org-publish-get-project-from-filename' specifications."
  316. ;; Check base directory.
  317. (should
  318. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  319. (file (expand-file-name "a.org" base))
  320. (org-publish-project-alist `(("p" :base-directory ,base))))
  321. (org-publish-get-project-from-filename file)))
  322. ;; Return nil if no appropriate project is found.
  323. (should-not
  324. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  325. (file (expand-file-name "a.org" base))
  326. (org-publish-project-alist `(("p" :base-directory ,base))))
  327. (org-publish-get-project-from-filename "/other/file.org")))
  328. ;; Return the first project effectively publishing the provided
  329. ;; file.
  330. (should
  331. (equal "p2"
  332. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  333. (file (expand-file-name "a.org" base))
  334. (org-publish-project-alist
  335. `(("p1" :base-directory "/other/")
  336. ("p2" :base-directory ,base)
  337. ("p3" :base-directory ,base))))
  338. (car (org-publish-get-project-from-filename file)))))
  339. ;; When :recursive in non-nil, allow files in sub-directories.
  340. (should
  341. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  342. (file (expand-file-name "sub/c.org" base))
  343. (org-publish-project-alist
  344. `(("p" :base-directory ,base :recursive t))))
  345. (org-publish-get-project-from-filename file)))
  346. (should-not
  347. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  348. (file (expand-file-name "sub/c.org" base))
  349. (org-publish-project-alist
  350. `(("p" :base-directory ,base :recursive nil))))
  351. (org-publish-get-project-from-filename file)))
  352. ;; Also, when :recursive is non-nil, follow symlinks to directories.
  353. (should
  354. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  355. (file (expand-file-name "link/link.org" base))
  356. (org-publish-project-alist
  357. `(("p" :base-directory ,base :recursive t))))
  358. (org-publish-get-project-from-filename file)))
  359. (should-not
  360. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  361. (file (expand-file-name "link/link.org" base))
  362. (org-publish-project-alist
  363. `(("p" :base-directory ,base :recursive nil))))
  364. (org-publish-get-project-from-filename file)))
  365. ;; Check :base-extension.
  366. (should
  367. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  368. (file (expand-file-name "file.txt" base))
  369. (org-publish-project-alist
  370. `(("p" :base-directory ,base :base-extension "txt"))))
  371. (org-publish-get-project-from-filename file)))
  372. (should-not
  373. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  374. (file (expand-file-name "file.txt" base))
  375. (org-publish-project-alist
  376. `(("p" :base-directory ,base :base-extension "org"))))
  377. (org-publish-get-project-from-filename file)))
  378. ;; When :base-extension has the special value `any', allow any
  379. ;; extension, including none.
  380. (should
  381. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  382. (file (expand-file-name "file.txt" base))
  383. (org-publish-project-alist
  384. `(("p" :base-directory ,base :base-extension any))))
  385. (org-publish-get-project-from-filename file)))
  386. (should
  387. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  388. (file (expand-file-name "noextension" base))
  389. (org-publish-project-alist
  390. `(("p" :base-directory ,base :base-extension any))))
  391. (org-publish-get-project-from-filename file)))
  392. ;; Pathological case: Handle both :extension any and :recursive t.
  393. (should
  394. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  395. (file (expand-file-name "sub/c.org" base))
  396. (org-publish-project-alist
  397. `(("p" :base-directory ,base :recursive t :base-extension any))))
  398. (org-publish-get-base-files (org-publish-get-project-from-filename file))))
  399. ;; Check :exclude property.
  400. (should-not
  401. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  402. (file (expand-file-name "a.org" base))
  403. (org-publish-project-alist
  404. `(("p" :base-directory ,base :exclude "a"))))
  405. (org-publish-get-project-from-filename file)))
  406. (should
  407. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  408. (file (expand-file-name "a.org" base))
  409. (org-publish-project-alist
  410. `(("p" :base-directory ,base :exclude "other"))))
  411. (org-publish-get-project-from-filename file)))
  412. ;; The regexp matches against relative file name, not absolute one.
  413. (should
  414. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  415. (file (expand-file-name "a.org" base))
  416. (org-publish-project-alist
  417. `(("p" :base-directory ,base :exclude "examples/pub"))))
  418. (org-publish-get-project-from-filename file)))
  419. ;; Check :include property.
  420. (should
  421. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  422. (file (expand-file-name "file.txt" base))
  423. (org-publish-project-alist
  424. `(("p" :base-directory ,base :include (,file)))))
  425. (org-publish-get-project-from-filename file)))
  426. ;; :include property has precedence over :exclude one.
  427. (should
  428. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  429. (file (expand-file-name "a.org" base))
  430. (org-publish-project-alist
  431. `(("p"
  432. :base-directory ,base
  433. :include (,(file-name-nondirectory file))
  434. :exclude "a"))))
  435. (org-publish-get-project-from-filename file)))
  436. ;; With optional argument, return a meta-project publishing provided
  437. ;; file.
  438. (should
  439. (equal "meta"
  440. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  441. (file (expand-file-name "a.org" base))
  442. (org-publish-project-alist
  443. `(("meta" :components ("p"))
  444. ("p" :base-directory ,base))))
  445. (car (org-publish-get-project-from-filename file t))))))
  446. (ert-deftest test-org-publish/file-relative-name ()
  447. "Test `org-publish-file-relative-name' specifications."
  448. ;; Turn absolute file names into relative ones if file belongs to
  449. ;; base directory.
  450. (should
  451. (equal "a.org"
  452. (let* ((base (expand-file-name "examples/pub/" org-test-dir))
  453. (file (expand-file-name "a.org" base)))
  454. (org-publish-file-relative-name file `(:base-directory ,base)))))
  455. (should
  456. (equal "pub/a.org"
  457. (let* ((base (expand-file-name "examples/" org-test-dir))
  458. (file (expand-file-name "pub/a.org" base)))
  459. (org-publish-file-relative-name file `(:base-directory ,base)))))
  460. ;; Absolute file names that do not belong to base directory are
  461. ;; unchanged.
  462. (should
  463. (equal "/name.org"
  464. (let ((base (expand-file-name "examples/pub/" org-test-dir)))
  465. (org-publish-file-relative-name "/name.org"
  466. `(:base-directory ,base)))))
  467. ;; Relative file names are unchanged.
  468. (should
  469. (equal "a.org"
  470. (let ((base (expand-file-name "examples/pub/" org-test-dir)))
  471. (org-publish-file-relative-name "a.org" `(:base-directory ,base))))))
  472. (provide 'test-ox-publish)
  473. ;;; test-ox-publish.el ends here