;; -*- 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") (defvar ennum-blog nil "Property list specifying ennum publish settings") (cl-defstruct (ennum-post (:constructor ennum-make-post) (:copier nil)) filename slug author date language links tangle summary tags thumbnail title translation-group video-posters) (cl-defstruct (ennum-operation (:constructor ennum-make-operation) (:copier nil)) inputs outputs publish) (defun ennum-posts (posts-directory) (sort (ennum--filter-map (lambda (file) (when (string= (file-name-extension file) "org") (ennum-read-post (ennum--expand-relative file (ennum-setting :posts-directory))))) (ennum-directory-files (ennum-setting :posts-directory))) '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)) :video-posters (ennum--filter-map (lambda (link) (pcase link (`("video" . ,path) `(,path . ,(ennum-video-poster path))))) links)))))) (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-directory-files (directory &optional full include-directories) "Return recursively the list of all files under DIRECTORY. Files are returned in depth first order. If FULL is non-nil, absolute file names are returned. Else, the file names are relative to DIRECTORY. If INCLUDE-DIRECTORIES is non-nil, include directories in the output." (let ((files (directory-files-recursively directory (rx anything) include-directories))) (if full files (seq-map (apply-partially 'string-remove-prefix ;; Expand directory in case it is a ;; relative path. (file-name-as-directory (expand-file-name directory))) files)))) (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 :ennum-translations (seq-remove (apply-partially 'equal post) posts) :ennum-video-posters (ennum-post-video-posters post)))))) 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 (ennum--expand-relative file other-files-directory)) :outputs (list (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 (ennum--expand-relative file other-files-directory) output-file)))))) (defun ennum-video-poster (video) (or (seq-find (lambda (file) (string= (file-name-base file) (file-name-base video))) (ennum-directory-files (ennum-setting :images-directory))) (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 interned-post-file (org-export-as 'ennum-html nil nil t (list :ennum-video-posters (ennum-post-video-posters post))))) (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) (ennum-directory-files 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)