Skip to content

Commit

Permalink
Merge pull request #593 from kaushalmodi/link-bundles
Browse files Browse the repository at this point in the history
feat: Now cross-posting links to other page bundle subtrees works + minor performance tweaks in buffer pre processing
  • Loading branch information
kaushalmodi committed Mar 17, 2022
2 parents cd1a55f + f7b15f7 commit a7e7626
Show file tree
Hide file tree
Showing 14 changed files with 671 additions and 156 deletions.
9 changes: 8 additions & 1 deletion Makefile
Expand Up @@ -194,7 +194,14 @@ diff:
@git diff

ert:
$(EMACS) --batch -l ert -L . -L $(OX_HUGO_TEST_DIR)/ert/ -l all_tests.el -eval '(ert-run-tests-batch-and-exit "$(TEST_MATCH)")'
$(EMACS) --batch \
--eval "(progn\
(setenv \"OX_HUGO_TMP_DIR\" \"$(ox_hugo_tmp_dir)\")\
(load-file (expand-file-name \"setup-ox-hugo.el\" \"$(OX_HUGO_TEST_DIR)\"))\
)" \
-L . -L $(OX_HUGO_TEST_DIR)/ert/ \
-l all_tests.el \
--eval "(ert-run-tests-batch-and-exit \"$(TEST_MATCH)\")"

test: vcheck_emacs vcheck_pandoc ert testmkgold do_test

Expand Down
10 changes: 6 additions & 4 deletions doc/ox-hugo-manual.org
Expand Up @@ -4077,6 +4077,8 @@ precedence order that the user desires.

This is the default precedence order:

- ~org-hugo-get-page-or-bundle-name~ :: Use the heading's
~:EXPORT_FILE_NAME~ property if set, else return /nil/.
- ~org-hugo-get-custom-id~ :: Use the heading's ~:CUSTOM_ID~ property
if set, else return /nil/.
- ~org-hugo-get-heading-slug~ :: Derive anchor using the heading's
Expand All @@ -4088,16 +4090,16 @@ This is the default precedence order:
guarantees to return some non-empty string.

Above precedence is set in the default value of
~org-hugo-anchor-functions~ --- ~'(org-hugo-get-custom-id
org-hugo-get-heading-slug org-hugo-get-md5)~.
~org-hugo-anchor-functions~ --- ~'(org-hugo-get-page-or-bundle-name
org-hugo-get-custom-id org-hugo-get-heading-slug org-hugo-get-md5)~.
**** Other anchor functions
- ~org-hugo-get-id~ :: This function returns the ID, if that property
is set for a heading.

If a user prefers to give higher precedence to Org ID than the
heading-derived-slug, they can customize ~org-hugo-anchor-functions~
to ~'(org-hugo-get-custom-id org-hugo-get-id
org-hugo-get-heading-slug org-hugo-get-md5)~.
to ~'(org-hugo-get-page-or-bundle-name org-hugo-get-custom-id
org-hugo-get-id org-hugo-get-heading-slug org-hugo-get-md5)~.

Now if an Org heading looks like this:

Expand Down
369 changes: 245 additions & 124 deletions ox-hugo.el

Large diffs are not rendered by default.

1 change: 1 addition & 0 deletions test/ert/all_tests.el
Expand Up @@ -24,3 +24,4 @@

;; (require 't1)
(require 'tanchor)
(require 'tslug)
4 changes: 2 additions & 2 deletions test/ert/org-test-lib.el
Expand Up @@ -55,8 +55,8 @@ variable, and communication channel under `info'."
(org-export--delete-comment-trees)
(let* ((tree (org-element-parse-buffer))
(info (org-combine-plists
(org-export--get-export-attributes)
(org-export-get-environment))))
(org-export--get-export-attributes 'hugo)
(org-export-get-environment 'hugo))))
(org-export--prune-tree tree info)
(org-export--remove-uninterpreted-data tree info)
(let ((info (org-combine-plists
Expand Down
296 changes: 296 additions & 0 deletions test/ert/tslug.el
@@ -0,0 +1,296 @@
;;; tslug.el --- Tests related to slug string derivation -*- lexical-binding: t; -*-

;; Authors: Kaushal Modi <kaushal.modi@gmail.com>
;; URL: https://ox-hugo.scripter.co

;; This file is not part of GNU Emacs.

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.

;;; Code:

(require 'org-test-lib)
(require 'ox-hugo)

(ert-deftest test-slug/return-nil ()
"Test nil return conditions."

;; Empty title
(should
(equal nil
(org-test-with-parsed-data
"* <point>"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info)))))

;; Heading with EXPORT_FILE_NAME.
(should
(equal nil
(org-test-with-parsed-data
"* Some Heading<point>"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info))))))

(ert-deftest test-slug/ignore-hugo-slug ()
"Test that EXPORT_HUGO_SLUG is not used to derive the slug."
;; EXPORT_FILE_NAME + EXPORT_HUGO_SLUG
(should
(string= "posts/file"
(org-test-with-parsed-data
"* Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: file
:EXPORT_HUGO_SLUG: slug
:END:"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info)))))

;; EXPORT_FILE_NAME + EXPORT_HUGO_SLUG + EXPORT_HUGO_SECTION
(should
(string= "section/file"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:END:
** Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: file
:EXPORT_HUGO_SLUG: slug
:END:"
(let ((el (nth 1 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info))))))

(ert-deftest test-slug/export-file-name ()
"Test derivation of the slug from EXPORT_FILE_NAME."

;; Only EXPORT_FILE_NAME
(should
(string= "posts/file"
(org-test-with-parsed-data
"* Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: file
:END:"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info)))))

;; EXPORT_FILE_NAME + EXPORT_HUGO_SECTION
(should
(string= "section/file"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:EXPORT_OPTIONS: toc:t
:END:
** Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: file
:END:"
(let ((el (nth 1 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info))))))

;; Leaf bundles
(ert-deftest test-slug/leaf-bundles ()
"Test derivation of the slug leaf bundles."
(should
(string= "posts/leaf"
(org-test-with-parsed-data
"* Some Heading<point>
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: leaf
:EXPORT_FILE_NAME: index
:END:"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info)))))

;; Leaf bundle in a section
(should
(string= "section/leaf"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:END:
** Some Heading<point>
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: leaf
:EXPORT_FILE_NAME: index
:END:"
(let ((el (nth 1 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info))))))

;; Branch bundles
(ert-deftest test-slug/branch-bundles ()
(should
(string= "posts/branch"
(org-test-with-parsed-data
"* Some Heading<point>
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: branch
:EXPORT_FILE_NAME: _index
:END:"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info)))))

;; Inherit :EXPORT_HUGO_BUNDLE
(should
(string= "posts/branch"
(org-test-with-parsed-data
"* Branch bundle
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: branch
:END:
** Landing page<point>
:PROPERTIES:
:EXPORT_FILE_NAME: _index
:END:"
(let ((el (nth 1 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info)))))

;; Page in branch bundle, inheritance
(should
(string= "posts/branch/branch-page"
(org-test-with-parsed-data
"* Branch bundle
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: branch
:END:
** Branch page<point>
:PROPERTIES:
:EXPORT_FILE_NAME: branch-page
:END:"
(let ((el (nth 1 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info)))))

;; Branch bundle in a section
(should
(string= "section/branch"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:END:
** Branch bundle
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: branch
:END:
*** Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: _index
:END:"
(let ((el (nth 2 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info)))))

;; Branch page in a branch bundle in a section
(should
(string= "section/branch/branch-page"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:END:
** Branch bundle
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: branch
:END:
*** Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: branch-page
:END:"
(let ((el (nth 2 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info))))))

;; Section
(ert-deftest test-slug/section ()

;; Section keyword
(should
(string= "section/file"
(org-test-with-parsed-data
"#+hugo_section: section
* Some Heading<point>
:PROPERTIES:
:EXPORT_FILE_NAME: file
:END:"
(let ((el (org-element-at-point)))
(org-hugo--heading-get-slug el info))))))

;; Section fragments
(ert-deftest test-slug/section-fragments ()

(should
(string= "section/sec2/sec3/file"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:END:
** Section 2
:PROPERTIES:
:EXPORT_HUGO_SECTION*: sec2
:END:
*** Section 3
:PROPERTIES:
:EXPORT_HUGO_SECTION*: sec3
:END:
**** Some page<point>
:PROPERTIES:
:EXPORT_FILE_NAME: file
:END:"
(let ((el (nth 3 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info)))))

;; Branch page in a branch bundle in section fragments.
(should
(string= "section/sec2/sec3/branch/branch-page"
(org-test-with-parsed-data
"* Section
:PROPERTIES:
:EXPORT_HUGO_SECTION: section
:END:
** Section 2
:PROPERTIES:
:EXPORT_HUGO_SECTION*: sec2
:END:
*** Section 3
:PROPERTIES:
:EXPORT_HUGO_SECTION*: sec3
:EXPORT_HUGO_BUNDLE: branch
:END:
**** Branch bundle
:PROPERTIES:
:EXPORT_HUGO_BUNDLE: branch
:END:
***** Some page<point>
:PROPERTIES:
:EXPORT_FILE_NAME: branch-page
:END:"
(let ((el (nth 4 (org-element-map tree 'headline #'identity info))))
(org-hugo--heading-get-slug el info))))))


(provide 'tslug)

;; Note: As of 2022-03-17, Org stable or bugfix version's (9.5.2)
;; `org-element-at-point' returns the Org element at point *but*
;; without any of the inherited properties. So `org-element-map' is
;; used where property inheritance needs to be tested (because that
;; does do the prop inheritance as expected!). This issue doesn't
;; exist in the `main' branch version of `org-element-at-point'.
;;
;; To get the 1st heading element: (nth 0 (org-element-map tree 'headline #'identity info))
;; To get the 2nd heading element: (nth 1 (org-element-map tree 'headline #'identity info))
;; ..

0 comments on commit a7e7626

Please sign in to comment.