~jakob/ox-haunt

f3c8fda6fee78f45a259e5d218a519dfd11c00c7 — Dimakakos Dimos 2 years ago 9d25ec4 v0.2
Add: support for single org-mode file flow

Changes implemented:
 - When using the subtree only flag in org-export, export the current
   subtree after checking if it or any of it's parents have the
   "EXPORT_FILE_NAME" property and that it is marked as DONE. Then parse
   title from heading, date from CLOSED or SCHEDULED state and tags from
   org-mode tags.

 - Add "A" binding in org-export UI to try and export all valid
   subtrees in current buffer.

 - Expose HAUNT_IMAGES_DIR as variable that handles where link images
   are to be saved.
1 files changed, 101 insertions(+), 22 deletions(-)

M ox-haunt.el
M ox-haunt.el => ox-haunt.el +101 -22
@@ 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