;; -*- lexical-binding: t -*-
(require 'ennu-html)
(require 'ennu-image)
(require 'ox)
(require 'seq)
(require 'cl)
(require 'memoize)
(defvar ennu-version "0.1.0"
"Ennu version string")
(defmacro ennu--with-file-contents (file &rest body)
(declare (indent defun))
`(with-temp-buffer
(insert-file-contents ,file)
,@body))
(defun ennu--org-output-filename (filename)
(concat (file-name-sans-extension filename) ".html"))
(defun ennu-publish-post (post)
;; TODO: Tangle post
`((,post)
(,(ennu--org-output-filename post))
,(lambda (output-file)
(ennu--with-file-contents post
(org-export-to-file 'ennu-html output-file))
;; (when-let (tangle-dir (or (plist-get posts-plist :valai-tangle-directory)
;; valai-tangle-directory))
;; (dolist (tangled-file
;; (org-babel-tangle-file post-path))
;; (when (member (file-name-extension tangled-file) '("sh" "py"))
;; (chmod tangled-file (string-to-number "755" 8)))
;; (make-directory tangle-dir t)
;; (rename-file tangled-file
;; (expand-file-name (file-name-nondirectory tangled-file)
;; tangle-dir)
;; t)))
)))
(defun ennu-publish-page (pages-directory page)
`((,page)
(,(ennu--org-output-filename
(string-remove-prefix
(file-name-as-directory pages-directory)
page)))
,(lambda (output-file)
(ennu--with-file-contents page
(org-export-to-file 'html output-file)))))
(defun ennu-video-poster (video)
(pcase (directory-files (ennu-setting :images-directory) nil
(concat (file-name-sans-extension video)
"\\.\\(jpg\\|png\\)$"))
(`(,poster . ,_) poster)
(`() (user-error "Poster for %s not found" video))))
(defun ennu-post-thumbnail (post)
(or (plist-get (ennu-post-metadata post) :thumbnail)
(seq-some (lambda (link)
(pcase link
(`("image" . ,path) path)
(`("video" . ,path) (ennu-video-poster path))))
(ennu-post-links post))))
(defun ennu-add-tongue-suffix (filename tongue)
(pcase tongue
("en" filename)
(_ (format "%s.%s.%s"
(file-name-sans-extension filename)
tongue
(file-name-extension filename)))))
(defun ennu-index-filename (filename-prefix tongue extension &optional page-number)
(ennu-add-tongue-suffix
(if page-number
(format "%s-%s.%s"
(file-name-nondirectory filename-prefix)
page-number
extension)
(format "%s.%s" (filename-nondirectory filename-prefix) extension))
tongue))
(defun ennu-publish-index (filename-prefix tongue title subtitle posts-per-page posts)
(let* ((number-of-pages (ceiling (length posts) posts-per-page))
(page-numbers (number-sequence 1 number-of-pages)))
`(,posts
,(cons (ennu-add-tongue-suffix (format "%s.html" filename-prefix) tongue)
(seq-map (apply-partially 'ennu-index-filename filename-prefix tongue "html")
page-numbers))
,(lambda (home-page &rest output-files)
(seq-mapn
(lambda (posts page-number output-file)
(with-temp-buffer
(insert (format "#+TITLE: %s\n" title subtitle))
(insert "#+OPTIONS: num:nil toc:nil\n\n")
(when subtitle
(insert (format "%s\n\n" subtitle)))
(seq-do (lambda (post)
(let ((metadata (ennu-post-metadata post)))
(insert (format "* [[post:%s]]\n" (file-name-base post)))
(insert (format-time-string
"/%b %e, %Y/\n\n"
(plist-get metadata :date)))
(when-let ((thumbnail (ennu-post-thumbnail post)))
(insert (format "[[thumbnail:%s]]\n\n" thumbnail)))
(when-let ((summary (plist-get metadata :summary)))
(insert summary)
(insert "\n\n"))
(when-let ((tags (plist-get metadata :filetags)))
(insert "Tags: ")
(insert
(string-join (seq-map (apply-partially 'format "[[tag:%s]]")
tags)
", "))
(insert "\n\n"))))
posts)
(unless (= page-number 1)
(insert (format "[[./%s][Newer posts]]\n"
(ennu-index-filename filename-prefix tongue "org" (1- page-number)))))
(unless (= page-number number-of-pages)
(insert (format "[[./%s][Older posts]]\n"
(ennu-index-filename filename-prefix tongue "org" (1+ page-number)))))
(org-export-to-file 'ennu-html output-file)))
(seq-partition posts posts-per-page)
page-numbers
output-files)
(copy-file (first output-files) home-page)))))
(defun ennu--absolute-uri (path)
(format "%s://%s/%s"
(ennu-setting :blog-scheme)
(ennu-setting :blog-domain)
path))
(defun ennu--atom-date (date)
(format-time-string "%Y-%m-%dT%H:%M:%SZ" date))
(defun ennu-publish-feed (feed-file title subtitle rights posts)
`(,posts
(,feed-file)
,(lambda (output-file)
(with-temp-file output-file
(insert
(xmlgen
`(feed :xmlns "http://www.w3.org/2005/Atom"
(id ,(ennu--absolute-uri ""))
(title ,title)
(updated ,(ennu--atom-date (plist-get (ennu-post-metadata (first posts)) :date)))
(link :rel "self" :href ,(ennu--absolute-uri feed-file))
(generator
,(format "Emacs %d.%d Org-mode %s ennu %s"
emacs-major-version emacs-minor-version (org-version) ennu-version))
(rights ,rights)
,@(when subtitle
`((subtitle ,subtitle)))
,@(seq-map 'ennu--feed-entry posts))))))))
(defun ennu--feed-entry (post)
(let* ((metadata (ennu-post-metadata post))
(lang (plist-get metadata :lang))
(link (ennu--absolute-uri (ennu--org-output-filename post))))
`(entry (id ,link)
(title :xml:lang ,lang ,(plist-get metadata :title))
(updated ,(ennu--atom-date (plist-get metadata :date)))
(author
(name ,(plist-get metadata :author))
(email ,user-mail-address))
(content :type "html" :xml:lang ,lang
,(ennu--with-file-contents post
(org-export-as 'ennu-html nil nil t)))
(link :rel "alternate" :href ,link)
,@(seq-map (lambda (tag) `(category :term ,tag))
(plist-get metadata :filetags)))))
(defun ennu-setting (property)
(pcase property
(:blog-scheme
(or (plist-get ennu-blog :blog-scheme)
"https"))
(:atom-feed-file
(or (plist-get ennu-blog :atom-feed-file)
"blog.atom"))
(:index-posts-per-page
(or (plist-get ennu-blog :index-posts-per-page)
12))
(:atom-feed-number-of-posts
(or (plist-get ennu-blog :atom-feed-number-of-posts)
12))
(:thumbnail-image-width
(or (plist-get ennu-blog :thumbnail-image-width)
320))
(:default-image-width
(or (plist-get ennu-blog :default-image-width)
640))
(:image-link-width
(or (plist-get ennu-blog :image-link-width)
1024))
((or :blog-domain :blog-license :blog-title
:images-directory :output-directory :posts-directory
:static-directory :tag-directory :video-directory)
(or (plist-get ennu-blog property)
(user-error "Property %s not defined" property)))
((or :blog-subtitle :pages-directory :unattached-static-files)
(plist-get ennu-blog property))
(_ (error "Unknown property %s" property))))
(defun ennu-image-output-filename (image width)
(format "%s-%spx.%s"
(file-name-sans-extension image)
width (file-name-extension image)))
(defun ennu--expand-relative (name directory)
(concat (file-name-as-directory directory) name))
(defun ennu-publish-image (widths image)
`((,image)
,(seq-map (apply-partially 'ennu-image-output-filename image)
widths)
,(lambda (&rest output-files)
(seq-mapn (lambda (output-file width)
(ennu-image-optimize-image
(ennu-image-resize-image image output-file width)))
output-files widths))))
(defun ennu-publish-copy (file)
`((,file) (,file) ,(apply-partially 'copy-file file)))
(defun ennu-post-links (post)
(ennu--with-file-contents post
(org-element-map (org-element-parse-buffer) 'link
(lambda (link)
(pcase link
(`(link ,properties . ,_)
(let ((link-type (org-element-property :type link)))
(when (member link-type (list "image" "static" "video"))
(cons link-type (org-element-property :path link))))))))))
(defun plist-put* (plist &rest key-value-pairs)
(pcase key-value-pairs
(`(,key ,value)
(plist-put plist key value))
(`(,key ,value . ,tail)
(apply 'plist-put* (plist-put plist key value) tail))))
(defun ennu-post-metadata (post)
(ennu--post-metadata-memoized
post (file-attribute-modification-time
(file-attributes post))))
(defmemoize ennu--post-metadata-memoized (post last-modified)
(ennu--with-file-contents post
(let ((metadata (org-export-get-environment 'ennu-html))
(export (apply-partially 'org-export-with-backend 'ennu-html)))
(seq-do (lambda (key)
(unless (plist-member metadata key)
(user-error "Metadata %s not specified" key)))
ennu-mandatory-metadata)
(plist-put*
metadata
:title (funcall export (first (plist-get metadata :title)))
:date (org-timestamp-to-time (first (plist-get metadata :date)))
:author (funcall export (first (plist-get metadata :author)))))))
(defvar ennu-mandatory-metadata
(list :title :date))
(defun newest-file (files)
(pcase files
(`(,head . ,tail)
(seq-reduce (lambda (file1 file2)
(if (file-newer-than-file-p file1 file2)
file1 file2))
tail head))))
(defun ennu-mkdir-p (directory)
(make-directory directory t))
(defun ennu-copy (source destination)
"Copy file or directory from SOURCE to DESTINATION."
(if (file-directory-p source)
(copy-directory source destination)
(make-directory (file-name-directory destination) t)
(copy-file source destination)))
(defun ennu--do-operation (temporary-directory operation)
(let ((expand (lambda (directory file)
(expand-file-name file directory))))
(pcase operation
(`(,input-files ,output-files ,publish)
(let ((absolute-output-files
(seq-map (apply-partially expand temporary-directory)
output-files))
(previous-output-files
(seq-map (apply-partially expand (ennu-setting :output-directory))
output-files)))
(cond
((and (seq-every-p 'file-exists-p previous-output-files)
(file-newer-than-file-p (newest-file previous-output-files)
(newest-file input-files)))
(message "Skipping publishing %s to %s" input-files output-files)
(seq-mapn 'ennu-copy previous-output-files absolute-output-files))
(t (message "Publishing %s to %s" input-files output-files)
(seq-do 'ennu-mkdir-p
(seq-uniq
(seq-map 'file-name-directory absolute-output-files)))
(apply publish absolute-output-files))))))))
(defun ennu--later-post (post1 post2)
(time-less-p (plist-get (ennu-post-metadata post2) :date)
(plist-get (ennu-post-metadata post1) :date)))
(defun ennu-publish-static-file (file)
`((,file) (,file) ,(apply-partially 'copy-file file)))
(defun ennu-posts (posts-directory)
(sort (file-expand-wildcards
(concat (file-name-as-directory
(ennu-setting :posts-directory))
"*.org"))
'ennu--later-post))
(defun ennu-publish-link (link)
(pcase link
(`("image" . ,path)
(ennu-publish-image
(list (ennu-setting :default-image-width)
(ennu-setting :image-link-width))
(ennu--expand-relative path (ennu-setting :images-directory))))
(`("static" . ,path)
(ennu-publish-copy (ennu--expand-relative path (ennu-setting :static-directory))))
(`("video" . ,path)
(ennu-publish-copy (ennu--expand-relative path (ennu-setting :video-directory)))
(ennu-publish-copy (ennu--expand-relative (ennu-video-poster path)
(ennu-setting :images-directory))))))
(defun ennu-post-tags (post)
(plist-get (ennu-post-metadata post) :filetags))
(defun ennu-post-tongue (post)
(plist-get (ennu-post-metadata post) :language))
(defun ennu-publish ()
(let ((make-backup-files nil)
(blog-title (ennu-setting :blog-title))
(blog-subtitle (ennu-setting :blog-subtitle))
(posts-per-page (ennu-setting :index-posts-per-page)))
(let ((temporary-directory (make-temp-file "ennu" t)))
(unwind-protect
(progn
(seq-do
(apply-partially 'ennu--do-operation temporary-directory)
(append
(let* ((posts (ennu-posts (ennu-setting :posts-directory)))
(tags (seq-uniq (seq-mapcat 'ennu-post-tags posts)))
(tongues (seq-uniq (seq-map 'ennu-post-tongue posts))))
(append
;; Publish posts
(seq-map 'ennu-publish-post posts)
;; Publish feed
(list (ennu-publish-feed (ennu-setting :atom-feed-file)
blog-title blog-subtitle
(ennu-setting :blog-license)
(seq-take posts (ennu-setting :atom-feed-number-of-posts))))
;; Publish indices
(seq-map
(lambda (tongue)
(ennu-publish-index
"index" tongue blog-title blog-subtitle posts-per-page
(seq-filter (lambda (post)
(string= tongue (ennu-post-tongue post)))
posts)))
tongues)
(seq-map
(lambda (tag)
(let ((posts (seq-filter (lambda (post)
(member tag (ennu-post-tags post)))
posts)))
(ennu-publish-index
(ennu--expand-relative tag (ennu-setting :tag-directory))
(ennu-post-tongue (first posts)) tag "" posts-per-page posts)))
tags)
;; Publish links
(seq-map 'ennu-publish-link
(seq-uniq (seq-mapcat 'ennu-post-links posts)))
;; Publish thumbnails
(seq-map
(apply-partially 'ennu-publish-image (list (ennu-setting :thumbnail-image-width)))
(seq-map (lambda (image)
(ennu--expand-relative image (ennu-setting :images-directory)))
(seq-uniq (seq-filter 'identity (seq-map 'ennu-post-thumbnail posts)))))))
;; Publish pages
(when-let ((pages-directory (ennu-setting :pages-directory)))
(seq-map (apply-partially 'ennu-publish-page pages-directory)
(seq-map (apply-partially 'string-remove-prefix
(file-name-as-directory (expand-file-name default-directory)))
(directory-files-recursively pages-directory "\\.org$"))))
;; Publish unattached static files
(seq-map 'ennu-publish-static-file
(ennu-setting :unattached-static-files))))
;; Replace old output directory
(let ((output (ennu-setting :output-directory)))
(delete-directory output t)
(rename-file temporary-directory output t)))
(delete-directory temporary-directory t)))))
(provide 'ennu)