diff --git a/ox-hugo.el b/ox-hugo.el new file mode 100644 index 0000000..373b542 --- /dev/null +++ b/ox-hugo.el @@ -0,0 +1,335 @@ +;;; ox-hugo.el --- Hugo Markdown Back-End for Org Export Engine + +;; Copyright (C) 2016 Helloyi He + +;; Author: Helloyi He +;; Keywords: org, hugo, markdown, gitpage + +;; This file is not part of GNU Emacs. + +;; GNU Emacs 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. + +;; GNU Emacs 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 GNU Emacs. If not, see . + +;;; Commentary: + +;; This library implements a Markdown back-end (hugo flavor) for Org +;; exporter, based on the `md' back-end. + +;;; Code: + +(require 'ox-blackfriday) + + +;;; User-Configurable Variables + +(defgroup org-export-hugo nil + "Options specific to Markdown export back-end." + :tag "Org Hugo Flavored Markdown" + :group 'org-export + :version "24.4" + :package-version '(Org . "8.0")) + +(defcustom org-hugo-metadata-format "toml" + "Format used to metadata. +This variable can be set to either `toml' or `yaml'." + :group 'org-export-hugo + :type 'string) + + +;;; Define Back-End + +(org-export-define-derived-backend 'hugo 'blackfriday + ;;:export-block '("HMD" "HUGO FLAVORED MARKDOWN") + :menu-entry + '(?H "Export to Hugo Flavored Markdown" + ((?M "To temporary buffer" + (lambda (a s v b) (org-hugo-export-as-md a s v))) + (?m "To file" (lambda (a s v b) (org-hugo-export-to-md a s v))) + (?o "To file and open" + (lambda (a s v b) + (if a (org-hugo-export-to-md t s v) + (org-open-file (org-hugo-export-to-md nil s v))))))) + :translate-alist '((src-block . org-hugo-src-block) + (inner-template . org-hugo-inner-template) + (table . org-hugo-table)) + + :options-alist '((:hugo-metadata-format "HUGO_METADATA_FORMAT" nil org-hugo-metadata-format) + (:hugo-tags "HUGO_TAGS" nil nil) + (:hugo-categories "HUGO_CATEGORIES" nil nil) + (:hugo-description "HUGO_DESCRIPTION" nil nil) + (:hugo-slug "HUGO_SLUG" nil nil) + (:hugo-url "HUGO_URL" nil nil))) + + +;;; Transcode Functions + +;;;; Src Block + +(defun org-hugo-src-block (src-block contents info) + "Transcode SRC-BLOCK element into Hugo Flavored Markdown +format. CONTENTS is nil. INFO is a plist used as a communication +channel." + (let* ((lang (org-element-property :language src-block)) + (code (org-element-property :value src-block)) + (shortcode (concat "{{< highlight " lang " >}}\n")) + (close-shortcode "{{< /highlight >}}\n")) + (concat shortcode code close-shortcode))) + + +;;;;; Table Stuff (stolen from ox-gfm.el + + +;;;; Table constants + +(defconst hugo-table-left-border "") +(defconst hugo-table-right-border "") +(defconst hugo-table-separator " |") + +;;;; Table-Row + +(defun org-gfm-table-row (table-row contents info) + "Transcode TABLE-ROW element from Org into GFM. CONTENTS is cell +contents of TABLE-ROW. INFO is a plist used as a communication +channel." + (let ((table (org-export-get-parent-table table-row))) + (when (and (eq 'rule (org-element-property :type table-row)) + ;; In GFM, rule is valid only at second row. + (eq 1 (cl-position + table-row + (org-element-map table 'table-row 'identity info)))) + (let* ((table (org-export-get-parent-table table-row)) + (header-p (org-export-table-row-starts-header-p table-row info)) + (build-rule (org-gfm-make-hline-builder table info ?-)) + (cols (cdr (org-export-table-dimensions table info)))) + (setq contents + (concat hugo-table-left-border + (mapconcat (lambda (col) (funcall build-rule col)) + (number-sequence 0 (- cols 1)) + hugo-table-separator) + hugo-table-right-border)))) + contents)) + + + +;;;; Table + +(defun org-hugo-table (table contents info) + "Transcode TABLE element into Blackfriday Flavored Markdown table. +CONTENTS is the contents of the table. INFO is a plist holding +contextual information." + (let* ((rows (org-element-map table 'table-row 'identity info)) + (no-header (or (<= (length rows) 1))) + (cols (cdr (org-export-table-dimensions table info))) + (build-dummy-header + (function + (lambda () + (let ((build-empty-cell (org-gfm-make-hline-builder table info ?\s)) + (build-rule (org-gfm-make-hline-builder table info ?-)) + (columns (number-sequence 0 (- cols 1)))) + (concat hugo-table-left-border + (mapconcat (lambda (col) (funcall build-empty-cell col)) + columns + gfm-table-separator) + hugo-table-right-border "\n" hugo-table-left-border + (mapconcat (lambda (col) (funcall build-rule col)) + columns + gfm-table-separator) + gfm-table-right-border "\n")))))) + (concat (when no-header (funcall build-dummy-header)) + (replace-regexp-in-string "\n\n" "\n" contents)))) + + + +;;;; Hugo metadata + +(defun org-hugo-metadata (info) + "..." + (let* ((mt-format (org-export-data (plist-get info :hugo-metadata-format) info)) + (title (org-hugo--get-metadata-title info)) + (date (org-hugo--get-metadata-date info)) + + (description (org-hugo--get-string-metadata info :hugo-description)) + (tags (org-hugo--get-list-metadata info :hugo-tags)) + (categories (org-hugo--get-list-metadata info :hugo-categories)) + (slug (org-hugo--get-string-metadata info :hugo-slug)) + (url (org-hugo--get-string-metadata info :hugo-url)) + + (data (list "title" title "date" date)) + (data (if description (plist-put data "description" description) data)) + (data (if tags (plist-put data "tags" tags) data)) + (data (if categories (plist-put data "categories" categories) data)) + (data (if slug (plist-put data "slug" slug) data)) + (data (if url (plist-put data "url" url) data))) + + (message "%s" data) + (cond ((string= mt-format "toml") (org-hugo--encode-metadata-to-toml data)) + ((string= mt-format "yaml") (org-hugo--encode-metadata-to-yaml data)) + ""))) + +(defun org-hugo--get-metadata-title (info) + "Get title of hugo. +If title is nil, set it with current buffer name" + (let ((title (org-hugo--get-string-metadata info :title))) + (if title title + (org-hugo-string--wrap-quotes + (file-name-sans-extension + (file-name-nondirectory (buffer-file-name))))))) + +(defun org-hugo--get-metadata-date (info) + "Get date of hugo. +If date is nil, set it with current time" + (let ((date (org-export-get-date info "%Y-%m-%d %T %z"))) + (if date (org-hugo-string--wrap-quotes date) + (org-hugo-string--wrap-quotes (format-time-string "%Y-%m-%d %T %z" (current-time)))))) + +(defun org-hugo--get-list-metadata (info key) + "Get hugo metadata of list type. +INFO is a plist holding export options. +KEY is a key of hugo metadata." + (let ((value (org-export-data (plist-get info key) info)) + (key (substring (symbol-name key) 1))) + (cond ((string-empty-p value) nil) + (t (mapcar 'org-hugo-string--wrap-quotes (split-string value)))))) + +(defun org-hugo--get-string-metadata (info key) + "Get hugo metadata of string type. +INFO is a plist holding export options. +KEY is a key of hugo metadata." + (let ((value (org-export-data (plist-get info key) info)) + (key (substring (symbol-name key) 1))) + (cond ((string-empty-p value) nil) + (t (org-hugo-string--wrap-quotes value))))) + +(defun org-hugo-string--wrap-quotes (str) + "Wrap double quotes to string." + (cond ((string-empty-p str) "") + ((and (string= (substring str 0 1) "\"") + (string= (substring str -1) "\"")) str) + (t (concat "\"" str "\"")))) + +(defun org-hugo--encode-metadata-to-toml (data) + "Encode hugo metadata to toml format." + (setq metadata "+++\n") + (cl-loop for (key value) on data by 'cddr do + (setq metadata + (concat metadata + key " = " + (cond ((or (string= key "tags") (string= key "categories")) + (concat "[" (mapconcat 'identity value ", ") "]")) + (value)) + "\n"))) + (concat metadata "+++\n")) + +(defun org-hugo--encode-metadata-to-yaml (data) + "Encode hugo metadata to yaml format." + (setq metadata "---\n") + (cl-loop for (key value) on data by 'cddr do + (setq metadata + (concat metadata key ": " + (cond ((string= key "tags") + (concat "[" (mapconcat 'identity value ", ") "]")) + ((string= key "categories") + (concat "\n - " (mapconcat 'identity value "\n - "))) + (value)) + "\n"))) + (concat metadata "---\n")) + +;;;; Template + +(defun org-hugo-inner-template (contents info) + "Return body of document after converting it to Markdown syntax. +CONTENTS is the transcoded contents string. INFO is a plist +holding export options." + (concat (org-hugo-metadata info) "\n" + (org-trim (org-html-inner-template (concat "\n" contents "\n") info)))) + + +;;; Interactive function + +;;;###autoload +(defun org-hugo-export-as-md (&optional async subtreep visible-only) + "Export current buffer to a Hugo Flavored Markdown buffer. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting buffer should be accessible +through the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Export is done in a buffer named \"*Org Hugo Export*\", which will +be displayed when `org-export-show-temporary-export-buffer' is +non-nil." + (interactive) + (org-export-to-buffer 'hugo "*Org Hugo Export*" + async subtreep visible-only nil nil (lambda () (text-mode)))) + + +;;;###autoload +(defun org-hugo-convert-region-to-md () + "Assume the current region has org-mode syntax, and convert it +to Hugo Flavored Markdown. This can be used in any buffer. +For example, you can write an itemized list in org-mode syntax in +a Markdown buffer and use this command to convert it." + (interactive) + (org-export-replace-region-by 'hugo)) + + +;;;###autoload +(defun org-hugo-export-to-md (&optional async subtreep visible-only) + "Export current buffer to a Hugo Flavored Markdown file. + +If narrowing is active in the current buffer, only export its +narrowed part. + +If a region is active, export that region. + +A non-nil optional argument ASYNC means the process should happen +asynchronously. The resulting file should be accessible through +the `org-export-stack' interface. + +When optional argument SUBTREEP is non-nil, export the sub-tree +at point, extracting information from the headline properties +first. + +When optional argument VISIBLE-ONLY is non-nil, don't export +contents of hidden elements. + +Return output file's name." + (interactive) + (let ((outfile (org-export-output-file-name ".md" subtreep))) + (org-export-to-file 'hugo outfile async subtreep visible-only))) + +;;;###autoload +(defun org-hugo-publish-to-md (plist filename pub-dir) + "Publish an org file to Markdown. + +FILENAME is the filename of the Org file to be published. PLIST +is the property list for the given project. PUB-DIR is the +publishing directory. + +Return output file name." + (org-publish-org-to 'hugo filename ".md" plist pub-dir)) + +(provide 'ox-hugo) + +;;; ox-hugo.el ends here