diff options
Diffstat (limited to 'ennum.el')
| -rw-r--r-- | ennum.el | 534 |
1 files changed, 534 insertions, 0 deletions
diff --git a/ennum.el b/ennum.el new file mode 100644 index 0000000..69a7b5b --- /dev/null +++ b/ennum.el @@ -0,0 +1,534 @@ +;; -*- lexical-binding: t -*- + +(require 'ennum-html) +(require 'ennum-image) +(require 'ox) +(require 'seq) +(require 'cl) +(require 'map) +(require 'memoize) +(require 'simple-httpd) + +(defvar ennum-version "0.1.0" + "Ennum version string") + +(cl-defstruct (ennum-post (:constructor ennum-make-post) + (:copier nil)) + filename slug author date language links tangle + summary tags thumbnail title translation-group) + +(cl-defstruct (ennum-operation (:constructor ennum-make-operation) + (:copier nil)) + inputs outputs publish) + +(defun ennum-posts (posts-directory) + (sort (seq-map 'ennum-read-post + (file-expand-wildcards + (concat (file-name-as-directory + (ennum-setting :posts-directory)) + "*.org"))) + 'ennum-later-post-p)) + +(defun ennum-later-post-p (post1 post2) + (time-less-p (ennum-post-date post2) + (ennum-post-date post1))) + +(defun ennum-read-post (filename) + (ennum--read-post + filename (file-attribute-modification-time + (file-attributes filename)))) + +(defmemoize ennum--read-post (filename last-modified) + (ennum-with-file-contents filename + (let ((metadata (org-export-get-environment 'ennum-html)) + (export (apply-partially 'org-export-with-backend 'ennum-html))) + (seq-do (lambda (key) + (unless (plist-member metadata key) + (user-error "Metadata %s not specified" key))) + ennum-mandatory-metadata) + (let* ((tree (org-element-parse-buffer)) + (links (org-element-map tree '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)))))))))) + (ennum-make-post + :filename filename + :slug (file-name-base filename) + :author (when-let (author (plist-get metadata :author)) + (funcall export (first author))) + :date (org-timestamp-to-time (first (plist-get metadata :date))) + :language (plist-get metadata :language) + :links links + ;; TODO: Deal with cases when the :tangle parameter is "yes" + :tangle (seq-uniq + (org-element-map tree 'src-block + (lambda (src-block) + (pcase (org-babel-get-src-block-info nil src-block) + (`(,_ ,_ ,arguments ,_ ,_ ,_ ,_) + (let ((tangle-output-file (map-elt arguments :tangle))) + (pcase tangle-output-file + ("no" nil) + (_ tangle-output-file)))))))) + :summary (when-let (summary (plist-get metadata :summary)) + (funcall export (first summary))) + :tags (plist-get metadata :filetags) + :thumbnail (or (plist-get metadata :thumbnail) + (seq-some (lambda (link) + (pcase link + (`("image" . ,path) path) + (`("video" . ,path) (ennum-video-poster path)))) + links)) + :title (funcall export (first (plist-get metadata :title))) + :translation-group (or (plist-get metadata :translation-group) + (file-name-base filename))))))) + +(defvar ennum-mandatory-metadata + (list :title :date)) + +(defmacro ennum-with-file-contents (file &rest body) + "Create a temporary buffer, insert contents of FILE into that +buffer and evaluate BODY. The value returned is the value of the +last form in BODY." + (declare (indent defun)) + `(with-temp-buffer + (insert-file-contents ,file) + ,@body)) + +(defun ennum--org-output-filename (filename) + (concat (file-name-sans-extension filename) ".html")) + +(defun ennum-publish-post (posts) + (let ((link-publish-operations + (seq-mapcat 'ennum-publish-link (seq-mapcat 'ennum-post-links posts))) + (input-post-files (seq-map 'ennum-post-filename posts))) + (append + (list + (ennum-make-operation + :inputs (append input-post-files + (seq-mapcat 'ennum-operation-inputs link-publish-operations)) + :outputs (seq-map 'ennum--org-output-filename input-post-files) + :publish + (lambda (&rest output-files) + (seq-mapn + (lambda (post output-file) + (let ((system-time-locale (map-elt (ennum-setting :locale-alist) + (ennum-post-language post) nil 'string=))) + (ennum-with-file-contents (ennum-post-filename post) + (org-export-to-file + 'ennum-html output-file nil nil nil nil + (list :translations (seq-remove (apply-partially 'equal post) posts)))))) + posts + output-files)))) + (ennum--filter-map + (lambda (post) + (when (ennum-post-tangle post) + (ennum-make-operation + :inputs (list (ennum-post-filename post)) + :outputs (seq-map (lambda (tangle-output) + (ennum--expand-relative tangle-output + (ennum-setting :static-directory))) + (ennum-post-tangle post)) + :publish (lambda (&rest output-files) + ;; TODO: Handle tangle outputs that are nested + ;; into directories, and when each tangle output + ;; is nested into a different directory. + (let ((post-file-copy (concat + (file-name-directory (first output-files)) + (file-name-nondirectory (ennum-post-filename post))))) + (copy-file (ennum-post-filename post) post-file-copy) + (org-babel-tangle-file post-file-copy) + (delete-file post-file-copy)))))) + posts) + link-publish-operations))) + +(defun ennum-publish-generic (other-files-directory file) + (ennum-make-operation + :inputs (list file) + :outputs + (list (string-remove-prefix + (file-name-as-directory other-files-directory) + (pcase (file-name-extension file) + ("org" (ennum--org-output-filename file)) + (_ file)))) + :publish (lambda (output-file) + (pcase (file-name-extension file) + ("org" (ennum-with-file-contents file + (org-export-to-file 'html output-file))) + (_ (ennum-copy file output-file)))))) + +(defun ennum-video-poster (video) + (pcase (directory-files (ennum-setting :images-directory) nil + (concat (file-name-sans-extension video) + "\\.\\(jpg\\|png\\)$")) + (`(,poster . ,_) poster) + (`() (user-error "Poster for %s not found" video)))) + +(defun ennum-add-tongue-suffix (filename tongue) + (pcase tongue + ("en" filename) + (_ (format "%s.%s%s" + (file-name-sans-extension filename) + tongue + (file-name-extension filename t))))) + +(defun ennum-index-filename (filename-prefix tongue &optional extension page-number) + (let ((extension (if extension (concat "." extension) ""))) + (ennum-add-tongue-suffix + (if page-number + (format "%s-%s%s" filename-prefix page-number extension) + (concat filename-prefix extension)) + tongue))) + +(defun ennum-publish-index (filename-prefix title posts-per-page posts) + (let* ((tongue (ennum-post-language (first posts))) + (number-of-pages (ceiling (length posts) posts-per-page)) + (page-numbers (number-sequence 1 number-of-pages))) + (ennum-make-operation + :inputs (seq-map 'ennum-post-filename posts) + :outputs (cons (ennum-add-tongue-suffix (format "%s.html" filename-prefix) tongue) + (seq-map (apply-partially 'ennum-index-filename filename-prefix tongue "html") + page-numbers)) + :publish + (lambda (home-page &rest output-files) + (let ((system-time-locale (map-elt (ennum-setting :locale-alist) tongue nil 'string=))) + (seq-mapn + (lambda (posts page-number output-file) + (with-temp-buffer + (insert (format "#+TITLE: %s\n" title)) + (insert (format "#+LANGUAGE: %s\n" tongue)) + (insert "#+OPTIONS: num:nil toc:nil\n\n") + (seq-do (lambda (post) + (insert (format "* [[post:%s]]\n" (ennum-post-slug post))) + (insert (format-time-string "/%b %e, %Y/\n\n" (ennum-post-date post))) + (when-let ((thumbnail (ennum-post-thumbnail post))) + (insert (format "[[thumbnail:%s]]\n\n" thumbnail))) + (when-let ((summary (ennum-post-summary post))) + (insert summary) + (insert "\n\n")) + (when-let ((tags (ennum-post-tags post))) + (insert "Tags: ") + (insert + (string-join + (seq-map (lambda (tag) + (format "[[tag:%s][%s]]" (ennum-add-tongue-suffix tag tongue) tag)) + tags) + ", ")) + (insert "\n\n"))) + posts) + (unless (= page-number 1) + (insert (format "[[./%s][Newer posts]]\n\n" + (ennum-index-filename (file-name-nondirectory filename-prefix) + tongue nil (1- page-number))))) + (unless (= page-number number-of-pages) + (insert (format "[[./%s][Older posts]]\n" + (ennum-index-filename (file-name-nondirectory filename-prefix) + tongue nil (1+ page-number))))) + (org-export-to-file 'html output-file))) + (seq-partition posts posts-per-page) + page-numbers + output-files)) + (copy-file (first output-files) home-page))))) + +(defun ennum--absolute-uri (path) + (format "%s://%s/%s" + (ennum-setting :blog-scheme) + (ennum-setting :blog-domain) + path)) + +(defun ennum--atom-date (date) + (format-time-string "%Y-%m-%dT%H:%M:%SZ" date)) + +(defun ennum-publish-feed (feed-file title rights posts) + (ennum-make-operation + :inputs (seq-map 'ennum-post-filename posts) + :outputs (list feed-file) + :publish + (lambda (output-file) + (with-temp-file output-file + (insert + (xmlgen + `(feed :xmlns "http://www.w3.org/2005/Atom" + (id ,(ennum--absolute-uri "")) + (title ,title) + (updated ,(ennum--atom-date (ennum-post-date (first posts)))) + (link :rel "self" :href ,(ennum--absolute-uri feed-file)) + (generator + ,(format "Emacs %d.%d Org-mode %s ennum %s" + emacs-major-version emacs-minor-version (org-version) ennum-version)) + (rights ,rights) + ,@(seq-map 'ennum--feed-entry posts)))))))) + +(defun ennum--feed-entry (post) + (let ((link (ennum--absolute-uri (ennum--org-output-filename + (ennum-post-filename post))))) + `(entry (id ,link) + (title :xml:lang ,(ennum-post-language post) ,(ennum-post-title post)) + (updated ,(ennum--atom-date (ennum-post-date post))) + ,@(when org-export-with-author + `((author + (name ,(ennum-post-author post)) + (email ,user-mail-address)))) + (content :type "html" :xml:lang ,(ennum-post-language post) + ,(ennum-with-file-contents (ennum-post-filename post) + (org-export-as 'ennum-html nil nil t))) + (link :rel "alternate" :href ,link) + ,@(seq-map (lambda (tag) `(category :term ,tag)) + (ennum-post-tags post))))) + +(defun ennum-setting (property) + (pcase property + ((or :blog-domain :blog-license :blog-title + :images-directory :output-directory :posts-directory + :static-directory :tag-directory :video-directory + :working-directory) + (or (plist-get ennum-blog property) + (user-error "Property %s not defined" property))) + ((or :atom-feed-number-of-posts :atom-feed-file + :blog-scheme :default-image-width + :image-link-width :index-posts-per-page + :locale-alist :other-files-directory + :tag-directory :thumbnail-image-width) + (plist-get (org-combine-plists + (list :atom-feed-number-of-posts 12 + :atom-feed-file "blog.atom" + :blog-scheme "https" + :default-image-width 640 + :image-link-width 1024 + :index-posts-per-page 12 + :locale-alist '(("en" . "C")) + :tag-directory "tag" + :thumbnail-image-width 320) + ennum-blog) + property)) + (_ (error "Unknown property %s" property)))) + +(defun ennum-image-output-filename (image width) + (format "%s-%spx.%s" + (file-name-sans-extension image) + width (file-name-extension image))) + +(defun ennum--expand-relative (name directory) + (concat (file-name-as-directory directory) name)) + +(defun ennum-publish-image (widths image) + (ennum-make-operation + :inputs (list image) + :outputs (seq-map (apply-partially 'ennum-image-output-filename image) + widths) + :publish + (lambda (&rest output-files) + (seq-mapn (lambda (output-file width) + (ennum-image-optimize-image + (ennum-image-resize-image image output-file width))) + output-files widths)))) + +(defun ennum-publish-copy (file) + (ennum-make-operation + :inputs (list file) + :outputs (list file) + :publish (apply-partially 'ennum-copy file))) + +(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 ennum-mkdir-p (directory) + (make-directory directory t)) + +(defun ennum-copy (source destination) + "Copy file or directory from SOURCE to DESTINATION. Overwrite +if DESTINATION already exists." + (if (file-directory-p source) + (copy-directory source destination) + (make-directory (file-name-directory destination) t) + (copy-file source destination t))) + +(defun ennum--filter-map (function sequence) + (seq-filter 'identity (seq-map function sequence))) + +;; TODO: What if a file was removed from the inputs? Detect that +;; change as well. + +;; Two separate problems +;; - tracking of list of inputs +;; - depending on a function of inputs, or equivalently intermediate files + +;; Solve both problems with an "ennum store" +(defun ennum--do-operation (temporary-directory operation) + ;; TODO: Check all outputs were created correctly. + (let* ((expand (lambda (directory file) + (expand-file-name file directory))) + (inputs (ennum-operation-inputs operation)) + (outputs (ennum-operation-outputs operation)) + (absolute-outputs + (seq-map (apply-partially expand temporary-directory) + outputs)) + (previous-outputs + (seq-map (apply-partially expand (ennum-setting :output-directory)) + outputs))) + (cond + ((and (seq-every-p 'file-exists-p previous-outputs) + (file-newer-than-file-p (newest-file previous-outputs) + (newest-file inputs))) + (message "Skipping publishing %s to %s" inputs outputs) + (seq-mapn 'ennum-copy previous-outputs absolute-outputs)) + (t (message "Publishing %s to %s" inputs outputs) + (seq-do 'ennum-mkdir-p + (seq-uniq + (seq-map 'file-name-directory absolute-outputs))) + (apply (ennum-operation-publish operation) absolute-outputs))))) + +(defun ennum-publish-static-file (file) + (ennum-make-operation + :inputs (list file) + :outputs (list file) + :publish (apply-partially 'ennum-copy file))) + +(defun ennum-publish-link (link) + (pcase link + (`("image" . ,path) + (list + (ennum-publish-image + (list (ennum-setting :default-image-width) + (ennum-setting :image-link-width)) + (ennum--expand-relative path (ennum-setting :images-directory))))) + (`("static" . ,path) + (list + (ennum-publish-copy (ennum--expand-relative path (ennum-setting :static-directory))))) + (`("video" . ,path) + (list + (ennum-publish-copy (ennum--expand-relative path (ennum-setting :video-directory))) + (ennum-publish-copy (ennum--expand-relative (ennum-video-poster path) + (ennum-setting :images-directory))))))) + +(defmacro ennum-with-current-directory (directory &rest body) + "Change to DIRECTORY, evaluate BODY and restore the current +working directory. The value returned is the value of the last +form in BODY." + (declare (indent defun)) + (let ((current-directory-symbol (make-symbol "current-directory"))) + `(let ((,current-directory-symbol default-directory)) + (unwind-protect (progn (cd ,directory) ,@body) + (cd ,current-directory-symbol))))) + +(defmacro ennum-with-temporary-directory (temporary-directory &rest body) + "Create temporary directory, evaluate BODY with the absolute +path of that directory assigned to TEMPORARY-DIRECTORY and +finally delete the temporary directory. The value returned is the +value of the last form in BODY." + (declare (indent defun)) + `(let ((,temporary-directory (make-temp-file "ennum" t))) + (chmod ,temporary-directory #o755) + (unwind-protect + (progn ,@body) + (delete-directory ,temporary-directory t)))) + +(defun ennum-many-to-many-group-by (function sequence) + "Apply FUNCTION to each element of SEQUENCE. +Separate the elements of SEQUENCE into an alist using the results +as keys. Keys are compared using `equal'." + (seq-reduce + (lambda (result element) + (seq-do + (lambda (key) + (map-put result key + (cons element (map-elt result key nil 'equal)) + 'equal)) + (funcall function element)) + result) + (seq-reverse sequence) + nil)) + +(defun ennum-publish () + (interactive) + (let ((make-backup-files nil) + (blog-title (ennum-setting :blog-title)) + (posts-per-page (ennum-setting :index-posts-per-page))) + (ennum-with-current-directory (ennum-setting :working-directory) + (ennum-with-temporary-directory temporary-directory + (seq-do + (apply-partially 'ennum--do-operation temporary-directory) + (append + (let ((posts (ennum-posts (ennum-setting :posts-directory)))) + (append + ;; Publish posts + (seq-mapcat (pcase-lambda (`(,translation-group . ,posts)) + (ennum-publish-post posts)) + (seq-group-by 'ennum-post-translation-group posts)) + ;; Publish feed + (list (ennum-publish-feed (ennum-setting :atom-feed-file) + blog-title + (ennum-setting :blog-license) + (seq-take posts (ennum-setting :atom-feed-number-of-posts)))) + ;; Publish indices + (seq-map + (pcase-lambda (`(,tongue . ,posts)) + (ennum-publish-index "index" blog-title posts-per-page posts)) + (seq-group-by 'ennum-post-language posts)) + (seq-mapcat + (pcase-lambda (`(,tag . ,posts)) + (seq-map + (pcase-lambda (`(,tongue . ,posts)) + (ennum-publish-index + (ennum--expand-relative tag (ennum-setting :tag-directory)) + tag posts-per-page posts)) + (seq-group-by 'ennum-post-language posts))) + (ennum-many-to-many-group-by 'ennum-post-tags posts)) + ;; Publish thumbnails + (seq-map + (apply-partially 'ennum-publish-image (list (ennum-setting :thumbnail-image-width))) + (seq-map (lambda (image) + (ennum--expand-relative image (ennum-setting :images-directory))) + (seq-uniq (ennum--filter-map 'ennum-post-thumbnail posts)))))) + ;; Publish other files + (when-let ((other-files-directory (ennum-setting :other-files-directory))) + (seq-map (apply-partially 'ennum-publish-generic other-files-directory) + (seq-map (apply-partially 'string-remove-prefix + (file-name-as-directory (expand-file-name default-directory))) + (directory-files-recursively other-files-directory ".")))))) + ;; Replace old output directory + (let ((output (ennum-setting :output-directory))) + (delete-directory output t) + (rename-file temporary-directory output t)))))) + +;;; Server +;;; +;;; Test HTTP server to serve the blog locally + +;; TODO: Why can't simple-httpd itself handle the unhexing? +(defun ennum-server-start () + (interactive) + (setq httpd-root (expand-file-name (ennum-setting :output-directory) + (ennum-setting :working-directory))) + (defun httpd/ (proc uri-path query request) + (let* ((uri-path (httpd-unhex uri-path)) + (file-path (httpd-gen-path uri-path))) + (cond + ;; If a HTML file other than index.html was requested, reject + ;; that request. + ((and (not (string= (file-name-nondirectory file-path) "index.html")) + (string= (file-name-extension file-path) "html")) + (httpd-error proc 404)) + ;; If the requested file was found, serve it. + ((= (httpd-status file-path) 200) + (httpd-serve-root proc httpd-root uri-path request)) + ;; Perhaps, this is a post or other HTML file that is being + ;; requested. Try serving a file with a .html extension + ;; appended. + (t (httpd-serve-root proc httpd-root (concat uri-path ".html") request))))) + (httpd-start) + (message "Ennum web server listening at http://localhost:%d" httpd-port)) + +(defun ennum-server-stop () + (interactive) + (httpd-stop) + (message "Ennum web server stopped")) + +(provide 'ennum) |