;; -*- 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") ;; TODO: Should the store have an absolute path to deal with directory ;; changes? Yes, since we ask for an absolute working directory, we ;; should. (defun ennum-intern (filename) (let* ((store-item (expand-file-name (ennum-file-hash filename) (ennum-setting :store))) (interned-path (expand-file-name (file-name-nondirectory filename) store-item))) (unless (file-exists-p store-item) (ennum-copy filename interned-path) (ennum--set-file-modes-recursively store-item #o555 #o444 #o555)) interned-path)) (defun ennum--hash () "Return SHA256 hash of buffer contents encoded using filename-safe base64 encoding. See RFC 4648ยง5. Briefly, this is a variant of base64 encoding where characters + and / are replaced respectively by - and _, and the pad character = is optional." (replace-regexp-in-string (rx (any ?+ ?/ ?=)) (lambda (str) (pcase str ("+" "-") ("/" "_") ("=" ""))) (base64-encode-string (secure-hash 'sha256 (current-buffer) nil nil t)))) (defun ennum-file-hash (file) (ennum--file-hash file (file-attribute-modification-time (file-attributes file)))) (defmemoize ennum--file-hash (file last-modified) (with-temp-buffer ;; TODO: Use ennum-with-file-contents (set-buffer-multibyte nil) (insert-file-contents-literally file) (ennum--hash))) (defun ennum--set-file-modes-recursively (directory directory-mode file-mode executable-file-mode) (chmod directory directory-mode) (seq-do (lambda (file) (cond ((file-directory-p file) (chmod file directory-mode)) ((file-executable-p file) (chmod file executable-file-mode)) (t (chmod file file-mode)))) (ennum-directory-files directory t t))) (cl-defstruct (ennum-exp (:constructor ennum-make-exp) (:copier nil)) inputs proc) (defun ennum--rewrite-inputs (exp) (pcase exp (`(ennum-input ,arg) (let ((input-identifier (gensym "input"))) (vector input-identifier (list arg) (list input-identifier)))) (`(,parent . ,childern) (seq-reduce (pcase-lambda (`[,result ,inputs ,input-identifiers] node) (pcase (ennum--rewrite-inputs node) (`[,modified-tree ,new-inputs ,new-input-identifiers] (vector (append result (list modified-tree)) (append inputs new-inputs) (append input-identifiers new-input-identifiers))))) exp (vector nil nil nil))) (leaf (vector exp nil nil)))) (defmacro ennum-exp (&rest body) (let ((raw-expression `(progn ,@body))) (pcase (ennum--rewrite-inputs raw-expression) (`[,rewritten-body ,inputs ,input-identifiers] `(ennum-eval (ennum-make-exp :inputs (list ,@inputs) :proc (lambda ,input-identifiers ,rewritten-body))))))) (defun ennum-eval (exp) (let ((output (expand-file-name (with-temp-buffer (let ((print-length nil) (print-level nil)) (print exp (current-buffer))) (ennum--hash)) (ennum-setting :store)))) ;; Create store if it doesn't exist (ennum-mkdir-p (ennum-setting :store)) ;; Create store item if it doesn't already exist (if (file-exists-p output) (message "Skipping build of %s" output) (message "Building %s" output) (ennum-with-temporary-directory temporary-directory (ennum-with-current-directory temporary-directory (apply (ennum-exp-proc exp) (ennum-exp-inputs exp))) (rename-file temporary-directory output)) (ennum--set-file-modes-recursively output #o555 #o444 #o555)) output)) (defun ennum-store-item-union (items) "Return a store item that is the union of ITEMS." (ennum-exp (seq-do (lambda (item) (seq-do (lambda (destination) ;; TODO: Print warning about overwriting files? (let ((source (expand-file-name destination item))) (unless (file-exists-p destination) (if (file-directory-p source) (make-directory destination) (copy-file source destination t))))) (reverse (ennum-directory-files item nil t)))) (ennum-input items)))) (defmacro ennum-make-functional-setter (name copier accessor) `(defun ,name (object new-value) (let ((object-copy (,copier object))) (setf (,accessor object-copy) new-value) object-copy))) (cl-defstruct (ennum-post (:constructor ennum-make-post) (:copier ennum-copy-post)) filename slug author date language links tangle summary tags thumbnail title translation-group translations) (ennum-make-functional-setter ennum-post-set-translations ennum-copy-post ennum-post-translations) (cl-defstruct (ennum-link (:constructor ennum-make-link) (:copier nil)) type path) (cl-defstruct (ennum-video-link (:constructor ennum-make-video-link) (:copier nil) (:include ennum-link (type 'video))) poster) (defun ennum-posts (posts-directory) (sort (seq-mapcat ;; Set translations slot of post objects. (pcase-lambda (`(,_ . ,posts)) (let ((translations (seq-map (lambda (post) (cons (ennum-post-language post) (ennum-post-slug post))) posts))) (seq-map (lambda (post) (ennum-post-set-translations post (seq-remove (pcase-lambda (`(,_ . ,slug)) (string= (ennum-post-slug post) slug)) translations))) posts))) ;; Read posts from org files and group them by translation ;; group. (seq-group-by 'ennum-post-translation-group (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)) (path (org-element-property :path link))) (pcase link-type ("video" (ennum-make-video-link :path path :poster (ennum-video-poster path))) (_ (ennum-make-link :type (intern link-type) :path path)))))))))) (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) (let ((path (ennum-link-path link))) (pcase (ennum-link-type link) ('image path) ('video (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-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-export-post (post interned-org-file &optional output-html-file body-only) "Export INTERNED-ORG-FILE of POST to OUTPUT-HTML-FILE using the ennum-html backend. INTERNED-ORG-FILE must be an org file interned into the ennum store. When optional argument BODY-ONLY is non-nil, only return body code, without surrounding template. See `org-export-as'. When optional argument OUTPUT-HTML-FILE is nil, return exported result as a string." (let ((output-file (ennum--org-output-filename (ennum-post-filename post)))) (ennum-mkdir-p (file-name-directory output-file)) (let ((system-time-locale (map-elt (ennum-setting :locale-alist) (ennum-post-language post) nil 'string=)) (ext-plist (list :ennum-translations (ennum-post-translations post) :ennum-video-posters (ennum--filter-map (lambda (link) (when (eq (ennum-link-type link) 'video) (cons (ennum-link-path link) (ennum-video-link-poster link)))) (ennum-post-links post))))) (ennum-with-file-contents interned-org-file (if output-html-file (org-export-to-file 'ennum-html output-file nil nil nil body-only ext-plist) (org-export-as 'ennum-html nil nil body-only ext-plist)))))) (defun ennum-publish-post (post) (append (list (ennum-exp (ennum-export-post post (ennum-input (ennum-intern (ennum-post-filename post))) (ennum--org-output-filename (ennum-post-filename post))))) (when (ennum-post-tangle post) (list (ennum-exp ;; TODO: Handle tangle outputs that are nested ;; into directories, and when each tangle output ;; is nested into a different directory. (let* ((input-org-file (ennum-input (ennum-intern (ennum-post-filename post)))) (post-file-copy (expand-file-name (file-name-nondirectory input-org-file) (ennum-setting :static-directory)))) (ennum-copy input-org-file post-file-copy) (org-babel-tangle-file post-file-copy) (delete-file post-file-copy))))) (seq-mapcat 'ennum-publish-link (ennum-post-links post)))) (defun ennum-publish-generic (other-files-directory file) (ennum-exp (let ((interned-file (ennum-input (ennum-intern (ennum--expand-relative file other-files-directory)))) (output-file (pcase (file-name-extension file) ("org" (ennum--org-output-filename file)) (_ file)))) (pcase (file-name-extension interned-file) ("org" (when (file-name-directory output-file) (ennum-mkdir-p (file-name-directory output-file))) (ennum-with-file-contents interned-file (org-export-to-file 'html output-file))) (_ (ennum-copy interned-file 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-exp (ennum-input (seq-map (lambda (post) (ennum-intern (ennum-post-filename post))) posts)) (let ((output-files (seq-map (apply-partially 'ennum-index-filename filename-prefix tongue "html") page-numbers)) (system-time-locale (map-elt (ennum-setting :locale-alist) tongue nil 'string=))) (seq-mapn (lambda (posts page-number output-file) (when (file-name-directory output-file) (ennum-mkdir-p (file-name-directory 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][%s]]\n" (ennum-post-slug post) (ennum-post-title 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) (ennum-add-tongue-suffix (format "%s.html" filename-prefix) tongue)))))) (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-exp ;; TODO: Create ennu-mkdir-p-for-file (when (file-name-directory feed-file) (ennum-mkdir-p (file-name-directory feed-file))) (with-temp-file feed-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-mapn (lambda (post interned-post-file) (ennum--feed-entry post interned-post-file)) posts (ennum-input (seq-map (lambda (post) (ennum-intern (ennum-post-filename post))) posts))))))))) (defun ennum--feed-entry (post interned-post-file) (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-export-post post interned-post-file 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 :store :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")) :store ".ennum" :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 (image width) (ennum-exp (let ((input-image (ennum-input (ennum-intern image)))) (ennum-mkdir-p (ennum-setting :images-directory)) (ennum-image-optimize-image (ennum-image-resize-image input-image (ennum--expand-relative (ennum-image-output-filename (file-name-nondirectory input-image) width) (ennum-setting :images-directory)) width))))) (defun ennum-publish-copy (file) (ennum-exp (ennum-copy (ennum-input (ennum-intern file)) 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) (when (file-name-directory destination) (ennum-mkdir-p (file-name-directory destination))) (copy-file source destination t))) (defun ennum--filter-map (function sequence) (seq-filter 'identity (seq-map function sequence))) (defun ennum-publish-link (link) (pcase (ennum-link-type link) ('image (seq-map (lambda (width) (ennum-publish-image (ennum--expand-relative (ennum-link-path link) (ennum-setting :images-directory)) width)) (list (ennum-setting :default-image-width) (ennum-setting :image-link-width)))) ('static (list (ennum-publish-copy (ennum--expand-relative (ennum-link-path link) (ennum-setting :static-directory))))) ('video (seq-map 'ennum-publish-copy (list (ennum--expand-relative (ennum-link-path link) (ennum-setting :video-directory)) (ennum--expand-relative (ennum-video-link-poster link) (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))) (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) (ennum-with-current-directory (ennum-setting :working-directory) (let* ((blog-title (ennum-setting :blog-title)) (posts (ennum-posts (ennum-setting :posts-directory))) (posts-per-page (ennum-setting :index-posts-per-page)) (other-files-directory (ennum-setting :other-files-directory)) (result (ennum-store-item-union (append ;; Publish posts (seq-mapcat 'ennum-publish-post 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)) ;; Publish tag indices (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 (lambda (image) (ennum-publish-image (ennum--expand-relative image (ennum-setting :images-directory)) (ennum-setting :thumbnail-image-width))) (ennum--filter-map 'ennum-post-thumbnail posts)) ;; Publish other files (seq-map (apply-partially 'ennum-publish-generic other-files-directory) (ennum-directory-files other-files-directory)))))) ;; Replace old output directory (when (file-exists-p (ennum-setting :output-directory)) (ennum--set-file-modes-recursively (ennum-setting :output-directory) #o755 #o644 #o755) (delete-directory (ennum-setting :output-directory) t)) (copy-directory result (ennum-setting :output-directory)) (message "Ennum published to %s" (expand-file-name (ennum-setting :output-directory)))))) ;;; 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)