Initial commit

1 files changed, 406 insertions, 0 deletions

diff --git a/ennu.el b/ennu.el
new file mode 100644
index 0000000..2e54938
--- /dev/null
+++ b/ennu.el
@@ -0,0 +1,406 @@
+;; -*- lexical-binding: t -*-
+
+(require 'ennu-html)
+(require 'ennu-image)
+(require 'ox)
+(require 'seq)
+(require 'cl)
+(require 'memoize)
+
+(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
+                   ;; TODO: Change this generator
+                   ,(format "Emacs %d.%d Org-mode %s ennu"
+                            emacs-major-version emacs-minor-version (org-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)