diff options
| -rw-r--r-- | ox-haunt.el | 123 |
1 files changed, 101 insertions, 22 deletions
diff --git a/ox-haunt.el b/ox-haunt.el index f23a16d..2d9f9fd 100644 --- a/ox-haunt.el +++ b/ox-haunt.el @@ -39,13 +39,15 @@ (?o "As Haunt file and open" (lambda (a s v b) (if a (ox-haunt-export-to-html t s v b) - (org-open-file (ox-haunt-export-to-html nil s v b))))))) + (org-open-file (ox-haunt-export-to-html nil s v b))))) + (?A "All subtrees as Haunt file" ox-haunt-export-all-subtrees-to-html))) :translate-alist '((link . ox-haunt-link) (template . ox-haunt-template)) :options-alist '((:tags "TAGS" nil nil) - (:haunt-base-dir "HAUNT_BASE_DIR" nil ox-haunt-base-dir))) + (:haunt-base-dir "HAUNT_BASE_DIR" nil ox-haunt-base-dir) + (:haunt-images-dir "HAUNT_IMAGES_DIR" nil ox-haunt-images-dir))) (defgroup org-export-haunt nil "Options for exporting Org mode files to Haunt HTML." @@ -61,6 +63,11 @@ This can be specified on a per-file basis with the 'HAUNT_BASE_DIR' keyword." "A list of keywords to include in the Haunt metadata section." :type '(list symbol)) +(defcustom ox-haunt-images-dir "/images/" + "The default path to copy images to. +This can be specified on a per-file basis with the 'HAUNT_IMAGES_DIR' keyword." + :type 'string) + (defun ox-haunt--check-base-dir (dest-path) "Raise an error if DEST-PATH does not name a valid directory." (unless dest-path @@ -74,11 +81,12 @@ DESC is the description part of the link, or the empty string. INFO is the current state of the export process, as a plist." (let* ((orig-path (org-element-property :path link)) (filename (file-name-nondirectory orig-path)) - (dest-path (plist-get info :haunt-base-dir))) + (dest-path (plist-get info :haunt-base-dir)) + (images-path (plist-get info :haunt-images-dir))) (when (string= "file" (org-element-property :type link)) (ox-haunt--check-base-dir dest-path) - (copy-file orig-path (concat dest-path "/images/" filename) t) - (org-element-put-property link :path (concat "./images/" filename))) + (copy-file orig-path (concat dest-path images-path filename) t) + (org-element-put-property link :path (concat ".." images-path filename))) (org-html-link link desc info))) (defun ox-haunt--keyword-as-string (info keyword) @@ -86,6 +94,48 @@ INFO is the current state of the export process, as a plist." INFO is the current state of the export process, as a plist." (org-export-data-with-backend (plist-get info keyword) 'ascii info)) +(defun ox-haunt--get-valid-subtree () + "Return the org element for a valid Haunt post subtree. +The condition to check validity is that the EXPORT_FILE_NAME +property is defined for the subtree element." + (catch 'break + (let ((level)) + (while :infinite + (let ((entry (org-element-at-point)) + (file-name (org-entry-get (point) "EXPORT_FILE_NAME"))) + (when file-name + (throw 'break entry))) + (setq level (org-up-heading-safe)) + (unless level + (throw 'break nil)))))) + +(defun ox-haunt--format-subtree-tags (tags) + "Given a string of tags in ':tag:...:' form return them +formatted as 'tag, ..., tag'." + (when tags + (string-join (split-string tags ":" t) ", "))) + +(defun ox-haunt--format-subtree-date (date) + "Given a string with an inactive org-mode timestamp return it +formatted as expected by haunt." + (when date + (let ((date-list (split-string (string-trim date "\\[" "\\]")))) + (concat (first date-list) " " + (third date-list))))) + +(defun ox-haunt--get-valid-subtree-metadata () + "With point on a subtree return the metadata of it or it's +first valid parent as a plist." + (when (ox-haunt--get-valid-subtree) + (let ((title (org-entry-get (point) "ITEM")) + (tags (ox-haunt--format-subtree-tags + (org-entry-get (point) "TAGS"))) + (date (ox-haunt--format-subtree-date + (or (org-entry-get (point) "CLOSED") + (org-entry-get (point) "SCHEDULED")))) + (todo-state (org-entry-get (point) "TODO"))) + `(:title ,title :tags ,tags :date ,date :todo-state ,todo-state)))) + (defun ox-haunt-template (contents info) "Return complete document string after HTML conversion. CONTENTS is the Org file's contents rendered as HTML. @@ -135,12 +185,21 @@ is non-nil." 'haunt subtreep visible-only) (org-export--get-buffer-attributes) (org-export-get-environment 'haunt subtreep))) - (dest-path (plist-get info :haunt-base-dir))) - (org-export-to-buffer 'haunt "*Org Haunt Export*" - async subtreep visible-only body-only - ;; Necessary to propagate a buffer-local value for `ox-haunt-base-dir'. - (append `(:haunt-base-dir ,dest-path) ext-plist) - (lambda () (set-auto-mode t))))) + (dest-path (plist-get info :haunt-base-dir)) + (subtree-metadata (when subtreep + (ox-haunt--get-valid-subtree-metadata)))) + (cond + ((and subtreep (not subtree-metadata)) + (message "This is not a valid subtree to export.")) + ((and subtreep (not (string-equal + (plist-get subtree-metadata :todo-state) + "DONE"))) + (message "The post is not marked as DONE, so it won't export")) + (t (org-export-to-buffer 'haunt "*Org Haunt Export*" + async subtreep visible-only body-only + ;; Necessary to propagate a buffer-local value for `ox-haunt-base-dir'. + (append `(:haunt-base-dir ,dest-path) subtree-metadata ext-plist) + (lambda () (set-auto-mode t))))))) ;;;###autoload (defun ox-haunt-export-to-html @@ -177,18 +236,38 @@ Return output file's name." 'haunt subtreep visible-only) (org-export--get-buffer-attributes) (org-export-get-environment 'haunt subtreep))) - (dest-path (plist-get info :haunt-base-dir))) + (dest-path (plist-get info :haunt-base-dir)) + (images-path (plist-get info :haunt-images-dir)) + (subtree-metadata (when subtreep + (ox-haunt--get-valid-subtree-metadata)))) (ox-haunt--check-base-dir dest-path) - (let* ((extension (concat "." (or (plist-get ext-plist :html-extension) - org-html-extension - "html"))) - (file (org-export-output-file-name extension subtreep)) - (file (concat dest-path "/posts/" file)) - (org-export-coding-system org-html-coding-system)) - (org-export-to-file 'haunt file - async subtreep visible-only body-only - ;; Necessary to propagate a buffer-local value for `ox-haunt-base-dir'. - (append `(:haunt-base-dir ,dest-path) ext-plist))))) + (cond + ((and subtreep (not subtree-metadata)) + (message "This is not a valid subtree to export.")) + ((and subtreep (not (string-equal + (plist-get subtree-metadata :todo-state) + "DONE"))) + (message "The post is not marked as DONE, so it won't export")) + (t (let* ((extension (concat "." (or (plist-get ext-plist :html-extension) + org-html-extension + "html"))) + (file (org-export-output-file-name extension subtreep)) + (file (concat dest-path "/posts/" file)) + (org-export-coding-system org-html-coding-system)) + (org-export-to-file 'haunt file + async subtreep visible-only body-only + ;; Necessary to propagate a buffer-local value for `ox-haunt-base-dir'. + (append `(:haunt-base-dir ,dest-path) + `(:haunt-images-dir ,images-path) + subtree-metadata ext-plist))))))) + +;;;###autoload +(defun ox-haunt-export-all-subtrees-to-html (&optional async visible-only body-only ext-plist) + "Export all valid subtrees in current buffer to Haunt post + files." + (org-map-entries + (lambda () (ox-haunt-export-to-html async t visible-only body-only ext-plist)) + "EXPORT_FILE_NAME<>\"\"")) (provide 'ox-haunt) ;;; ox-haunt.el ends here |