path: root/ennum-html.el

;; -*- lexical-binding: t -*-

(require 'ox)
(require 'subr-x)
(require 'xmlgen)

(defconst ennum-html--iso-639-1-alist
  '(("ab" . "аҧсуа бызшәа, аҧсшәа")
    ("aa" . "Afaraf")
    ("af" . "Afrikaans")
    ("ak" . "Akan")
    ("sq" . "Shqip")
    ("am" . "አማርኛ")
    ("ar" . "العربية")
    ("an" . "aragonés")
    ("hy" . "Հայերեն")
    ("as" . "অসমীয়া")
    ("av" . "авар мацӀ, магӀарул мацӀ")
    ("ae" . "avesta")
    ("ay" . "aymar aru")
    ("az" . "azərbaycan dili")
    ("bm" . "bamanankan")
    ("ba" . "башҡорт теле")
    ("eu" . "euskara, euskera")
    ("be" . "беларуская мова")
    ("bn" . "বাংলা")
    ("bh" . "भोजपुरी")
    ("bi" . "Bislama")
    ("bs" . "bosanski jezik")
    ("br" . "brezhoneg")
    ("bg" . "български език")
    ("my" . "ဗမာစာ")
    ("ca" . "català")
    ("ch" . "Chamoru")
    ("ce" . "нохчийн мотт")
    ("ny" . "chiCheŵa, chinyanja")
    ("zh" . "中文 (Zhōngwén), 汉语, 漢語")
    ("cv" . "чӑваш чӗлхи")
    ("kw" . "Kernewek")
    ("co" . "corsu, lingua corsa")
    ("cr" . "ᓀᐦᐃᔭᐍᐏᐣ")
    ("hr" . "hrvatski jezik")
    ("cs" . "čeština, český jazyk")
    ("da" . "dansk")
    ("dv" . "ދިވެހި")
    ("nl" . "Nederlands, Vlaams")
    ("dz" . "རྫོང་ཁ")
    ("en" . "English")
    ("eo" . "Esperanto")
    ("et" . "eesti, eesti keel")
    ("ee" . "Eʋegbe")
    ("fo" . "føroyskt")
    ("fj" . "vosa Vakaviti")
    ("fi" . "suomi, suomen kieli")
    ("fr" . "français, langue française")
    ("ff" . "Fulfulde, Pulaar, Pular")
    ("gl" . "galego")
    ("ka" . "ქართული")
    ("de" . "Deutsch")
    ("el" . "ελληνικά")
    ("gn" . "Avañe'ẽ")
    ("gu" . "ગુજરાતી")
    ("ht" . "Kreyòl ayisyen")
    ("ha" . "(Hausa) هَوُسَ")
    ("he" . "עברית")
    ("hz" . "Otjiherero")
    ("hi" . "हिन्दी, हिंदी")
    ("ho" . "Hiri Motu")
    ("hu" . "magyar")
    ("ia" . "Interlingua")
    ("id" . "Bahasa Indonesia")
    ("ie" . "Originally called Occidental; then Interlingue after WWII")
    ("ga" . "Gaeilge")
    ("ig" . "Asụsụ Igbo")
    ("ik" . "Iñupiaq, Iñupiatun")
    ("io" . "Ido")
    ("is" . "Íslenska")
    ("it" . "Italiano")
    ("iu" . "ᐃᓄᒃᑎᑐᑦ")
    ("ja" . "日本語 (にほんご)")
    ("jv" . "ꦧꦱꦗꦮ, Basa Jawa")
    ("kl" . "kalaallisut, kalaallit oqaasii")
    ("kn" . "ಕನ್ನಡ")
    ("kr" . "Kanuri")
    ("ks" . "कश्मीरी, كشميري‎")
    ("kk" . "қазақ тілі")
    ("km" . "ខ្មែរ, ខេមរភាសា, ភាសាខ្មែរ")
    ("ki" . "Gĩkũyũ")
    ("rw" . "Ikinyarwanda")
    ("ky" . "Кыргызча, Кыргыз тили")
    ("kv" . "коми кыв")
    ("kg" . "Kikongo")
    ("ko" . "한국어")
    ("ku" . "Kurdî, كوردی‎")
    ("kj" . "Kuanyama")
    ("la" . "latine, lingua latina")
    ("lb" . "Lëtzebuergesch")
    ("lg" . "Luganda")
    ("li" . "Limburgs")
    ("ln" . "Lingála")
    ("lo" . "ພາສາລາວ")
    ("lt" . "lietuvių kalba")
    ("lu" . "Tshiluba")
    ("lv" . "latviešu valoda")
    ("gv" . "Gaelg, Gailck")
    ("mk" . "македонски јазик")
    ("mg" . "fiteny malagasy")
    ("ms" . "bahasa Melayu, بهاس ملايو‎")
    ("ml" . "മലയാളം")
    ("mt" . "Malti")
    ("mi" . "te reo Māori")
    ("mr" . "मराठी")
    ("mh" . "Kajin M̧ajeļ")
    ("mn" . "Монгол хэл")
    ("na" . "Dorerin Naoero")
    ("nv" . "Diné bizaad")
    ("nd" . "isiNdebele")
    ("ne" . "नेपाली")
    ("ng" . "Owambo")
    ("nb" . "Norsk bokmål")
    ("nn" . "Norsk nynorsk")
    ("no" . "Norsk")
    ("ii" . "ꆈꌠ꒿ Nuosuhxop")
    ("nr" . "isiNdebele")
    ("oc" . "occitan, lenga d'òc")
    ("oj" . "ᐊᓂᔑᓈᐯᒧᐎᓐ")
    ("cu" . "ѩзыкъ словѣньскъ")
    ("om" . "Afaan Oromoo")
    ("or" . "ଓଡ଼ିଆ")
    ("os" . "ирон æвзаг")
    ("pa" . "ਪੰਜਾਬੀ")
    ("pi" . "पाऴि")
    ("fa" . "فارسی")
    ("pl" . "język polski, polszczyzna")
    ("ps" . "پښتو")
    ("pt" . "Português")
    ("qu" . "Runa Simi, Kichwa")
    ("rm" . "rumantsch grischun")
    ("rn" . "Ikirundi")
    ("ro" . "Română")
    ("ru" . "Русский")
    ("sa" . "संस्कृतम्")
    ("sc" . "sardu")
    ("sd" . "सिन्धी, سنڌي، سندھی‎")
    ("se" . "Davvisámegiella")
    ("sm" . "gagana fa'a Samoa")
    ("sg" . "yângâ tî sängö")
    ("sr" . "српски језик")
    ("gd" . "Gàidhlig")
    ("sn" . "chiShona")
    ("si" . "සිංහල")
    ("sk" . "slovenčina, slovenský jazyk")
    ("sl" . "slovenski jezik, slovenščina")
    ("so" . "Soomaaliga, af Soomaali")
    ("st" . "Sesotho")
    ("es" . "Español")
    ("su" . "Basa Sunda")
    ("sw" . "Kiswahili")
    ("ss" . "SiSwati")
    ("sv" . "svenska")
    ("ta" . "தமிழ்")
    ("te" . "తెలుగు")
    ("tg" . "тоҷикӣ, toçikī, تاجیکی‎")
    ("th" . "ไทย")
    ("ti" . "ትግርኛ")
    ("bo" . "བོད་ཡིག")
    ("tk" . "Türkmen, Түркмен")
    ("tl" . "Wikang Tagalog")
    ("tn" . "Setswana")
    ("to" . "faka Tonga")
    ("tr" . "Türkçe")
    ("ts" . "Xitsonga")
    ("tt" . "татар теле, tatar tele")
    ("tw" . "Twi")
    ("ty" . "Reo Tahiti")
    ("ug" . "ئۇيغۇرچە‎, Uyghurche")
    ("uk" . "Українська")
    ("ur" . "اردو")
    ("uz" . "Oʻzbek, Ўзбек, أۇزبېك‎")
    ("ve" . "Tshivenḓa")
    ("vi" . "Tiếng Việt")
    ("vo" . "Volapük")
    ("wa" . "walon")
    ("cy" . "Cymraeg")
    ("wo" . "Wollof")
    ("fy" . "Frysk")
    ("xh" . "isiXhosa")
    ("yi" . "ייִדיש")
    ("yo" . "Yorùbá")
    ("za" . "Saɯ cueŋƅ, Saw cuengh")
    ("zu" . "isiZulu")))

(defun expand-file-name* (name base-directory)
  (expand-file-name name (concat "/" base-directory)))

(org-export-define-derived-backend 'ennum-html 'html
  :translate-alist
  '((inner-template . ennum-html-inner-template)
    (link . ennum-html-link))
  :options-alist
  '((:summary "SUMMARY" nil nil parse)
    (:thumbnail "THUMBNAIL" nil nil t)
    (:translation-group "TRANSLATION_GROUP" nil nil t)))

(defun ennum-html-inner-template (contents info)
  (concat
   ;; Table of contents
   (let ((depth (plist-get info :with-toc)))
     (when depth (org-html-toc depth info)))
   ;; Beginning of h-entry
   "<article class=\"h-entry\">"
   ;; Title
   (format "<h1 class=\"p-name\">%s</h1>\n"
           (org-export-data (plist-get info :title) info))
   ;; Author and date
   (let ((author (when (plist-get info :with-author)
                   (plist-get info :author)))
         (date (when (plist-get info :with-date)
                 (org-export-get-date info))))
     (when (or author date)
       (xmlgen `(p "Published"
                   ,@(when author
                       `(" by "
                         (a :class "p-author h-card"
                            :href ,(ennum--absolute-uri "")
                            ,(car (plist-get info :author)))))
                   ,@(when date
                       `(" on "
                         (time :class "dt-published"
                               :datetime ,(org-export-get-date info "%Y-%m-%d 12:00:00")
                               ,(org-export-get-date info "%B %d, %Y"))))))))
   ;; Interlanguage language links
   (when-let (translations (ennum-post-translations (plist-get info :ennum-post)))
     (format "<p>In other languages: %s</p>"
             (mapconcat
              (pcase-lambda (`(,lang . ,slug))
                (replace-regexp-in-string
                 "<a " (format "<a hreflang=\"%s\" " lang)
                 (ennum-html-export-post
                  slug
                  (map-elt ennum-html--iso-639-1-alist lang)
                  (org-export-backend-name
                   (plist-get info :back-end)))))
              translations
              ", ")))
   ;; Tags
   (when-let (tags (plist-get info :filetags))
     (format "<p>Tags: %s</p>"
             (mapconcat
              (lambda (tag)
                (replace-regexp-in-string
                 "<a " "<a class=\"p-category\" "
                 (ennum-html-export-tag
                  (ennum-add-tongue-suffix tag (plist-get info :language))
                  tag (org-export-backend-name (plist-get info :back-end)))))
              tags
              ", ")))
   ;; Summary
   (format "<div class=\"p-summary\">%s</div>"
           (org-export-data (plist-get info :summary) info))
   ;; Document contents
   (format "<div class=\"e-content\">%s</div>" contents)
   ;; Footnotes section
   (org-html-footnote-section info)
   "</article>"))

(defun ennum-html-find-link (type path info)
  "Find link of TYPE and PATH in post object stored in
:ennum-posts of property list INFO."
  (seq-find (lambda (link)
              (and (eq (ennum-link-type link) type)
                   (string= (ennum-link-path link) path)))
            (ennum-post-links (plist-get info :ennum-post))))

(defun ennum-html-link (link desc info)
  ;; We override the html link transcoder to handle image, post and
  ;; video links differently. We cannot use the `:export' property of
  ;; `org-link-parameters' since those functions cannot access the
  ;; `info' communication channel.
  (let ((path (org-element-property :path link)))
    (pcase (org-element-property :type link)
      ("image"
       ;; Convert image links to file links, get them transcoded by
       ;; `org-html-link' and then remove the file:// scheme from the
       ;; URI. Finally insert the transcoded image link in a link to a
       ;; larger image as specified by the :image-link-width setting.
       (format "<a href=\"%s\">%s</a>"
               (expand-file-name*
                (ennum-image-output-filename
                 path (ennum-setting :image-link-width))
                (ennum-setting :images-directory))
               (replace-regexp-in-string
                (rx (group (or "src" "data")) "=\"file://") "\\1=\""
                (org-html-link
                 (org-element-put-property
                  (org-element-put-property
                   link :path (url-encode-url
                               (expand-file-name*
                                (ennum-image-output-filename
                                 path (ennum-setting :default-image-width))
                                (ennum-setting :images-directory))))
                  :type "file")
                 desc info))))
      ("post"
       (ennum-html-export-post
        path
        (or desc (ennum-post-link-target-title
                  (ennum-html-find-link 'post path info)))
        (org-export-backend-name (plist-get info :back-end))))
      ("video"
       (xmlgen
        `(video :src ,(url-encode-url
                       (expand-file-name* path (ennum-setting :video-directory)))
                :poster ,(url-encode-url
                          (expand-file-name*
                           (ennum-video-link-poster
                            (ennum-html-find-link 'video path info))
                           (ennum-setting :images-directory)))
                :preload "none"
                :controls "")))
      ;; Pass other link types to org-html-link
      (_ (org-html-link link desc info)))))

(defmacro ennum-html-follow (path)
  `(ennum-with-current-directory (ennum-setting :working-directory)
     (find-file ,path)))

;; TODO: Pass title through org-export-data-with-backend or something
;; similar in order to export org syntax in title
(defun ennum-html-export-post (path desc backend)
  (pcase backend
    ((or 'ennum-html 'html)
     (xmlgen `(a :href ,(url-encode-url
                         (expand-file-name* path (ennum-setting :posts-directory)))
                 ,desc)))))

(defun ennum-html-follow-post (path)
  (ennum-html-follow (expand-file-name (concat path ".org")
                                       (ennum-setting :posts-directory))))

(org-link-set-parameters
 "post"
 :export 'ennum-html-export-post
 :follow 'ennum-html-follow-post)

(defun ennum-html-follow-image (path)
  (ennum-html-follow (expand-file-name path (ennum-setting :images-directory))))

(org-link-set-parameters
 "image" :follow 'ennum-html-follow-image)

(defun ennum-html-export-thumbnail (path desc backend)
  (pcase backend
    ((or 'ennum-html 'html)
     (xmlgen
      `(img :src ,(url-encode-url
                   (expand-file-name*
                    (ennum-image-output-filename
                     path (ennum-setting :thumbnail-image-width))
                    (ennum-setting :images-directory))))))))

(org-link-set-parameters
 "thumbnail"
 :export 'ennum-html-export-thumbnail
 :follow 'ennum-html-follow-image)

(defun ennum-html-follow-video (path)
  (ennum-html-follow (expand-file-name path
                                       (ennum-setting :video-directory))))

(org-link-set-parameters
 "video"
 :follow 'ennum-html-follow-video)

(defun ennum-html-export-static (path desc backend)
  (pcase backend
    ((or 'ennum-html 'html)
     (xmlgen
      `(a :href ,(url-encode-url
                  (expand-file-name* path (ennum-setting :static-directory)))
          ,desc)))))

(org-link-set-parameters
 "static" :export 'ennum-html-export-static)

(org-link-set-parameters
 "tangle" :export 'ennum-html-export-static)

(defun ennum-html-export-tag (tag desc backend)
  (pcase backend
    ((or 'ennum-html 'html)
     (xmlgen
      `(a :href ,(url-encode-url
                  (expand-file-name* tag (ennum-setting :tag-directory)))
          ,(or desc tag))))))

(org-link-set-parameters
 "tag" :export 'ennum-html-export-tag)

(provide 'ennum-html)