diff options
Diffstat (limited to 'ennu.el')
-rw-r--r-- | ennu.el | 524 |
1 files changed, 0 insertions, 524 deletions
diff --git a/ennu.el b/ennu.el deleted file mode 100644 index 439e1d9..0000000 --- a/ennu.el +++ /dev/null @@ -1,524 +0,0 @@ -;; -*- lexical-binding: t -*- - -(require 'ennu-html) -(require 'ennu-image) -(require 'ox) -(require 'seq) -(require 'cl) -(require 'map) -(require 'memoize) -(require 'simple-httpd) - -(defvar ennu-version "0.1.0" - "Ennu version string") - -(cl-defstruct (ennu-post (:constructor ennu-make-post) - (:copier nil)) - filename slug author date language links tangle - summary tags thumbnail title translation-group) - -(cl-defstruct (ennu-operation (:constructor ennu-make-operation) - (:copier nil)) - inputs outputs publish) - -(defun ennu-posts (posts-directory) - (sort (seq-map 'ennu-read-post - (file-expand-wildcards - (concat (file-name-as-directory - (ennu-setting :posts-directory)) - "*.org"))) - 'ennu-later-post-p)) - -(defun ennu-later-post-p (post1 post2) - (time-less-p (ennu-post-date post2) - (ennu-post-date post1))) - -(defun ennu-read-post (filename) - (ennu--read-post - filename (file-attribute-modification-time - (file-attributes filename)))) - -(defmemoize ennu--read-post (filename last-modified) - (ennu-with-file-contents filename - (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) - (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)))))))))) - (ennu-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) (ennu-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 ennu-mandatory-metadata - (list :title :date)) - -(defmacro ennu-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 ennu--org-output-filename (filename) - (concat (file-name-sans-extension filename) ".html")) - -(defun ennu-publish-post (posts) - (let ((link-publish-operations - (seq-mapcat 'ennu-publish-link (seq-mapcat 'ennu-post-links posts))) - (input-post-files (seq-map 'ennu-post-filename posts))) - (append - (list - (ennu-make-operation - :inputs (append input-post-files - (seq-mapcat 'ennu-operation-inputs link-publish-operations)) - :outputs (seq-map 'ennu--org-output-filename input-post-files) - :publish - (lambda (&rest output-files) - (seq-mapn - (lambda (post output-file) - (let ((system-time-locale (map-elt (ennu-setting :locale-alist) - (ennu-post-language post) nil 'string=))) - (ennu-with-file-contents (ennu-post-filename post) - (org-export-to-file - 'ennu-html output-file nil nil nil nil - (list :translations (seq-remove (apply-partially 'equal post) posts)))))) - posts - output-files)))) - (ennu--filter-map - (lambda (post) - (when (ennu-post-tangle post) - (ennu-make-operation - :inputs (list (ennu-post-filename post)) - :outputs (seq-map (lambda (tangle-output) - (ennu--expand-relative tangle-output - (ennu-setting :static-directory))) - (ennu-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 (ennu-post-filename post))))) - (copy-file (ennu-post-filename post) post-file-copy) - (org-babel-tangle-file post-file-copy) - (delete-file post-file-copy)))))) - posts) - link-publish-operations))) - -(defun ennu-publish-generic (other-files-directory file) - (ennu-make-operation - :inputs (list file) - :outputs - (list (string-remove-prefix - (file-name-as-directory other-files-directory) - (pcase (file-name-extension file) - ("org" (ennu--org-output-filename file)) - (_ file)))) - :publish (lambda (output-file) - (pcase (file-name-extension file) - ("org" (ennu-with-file-contents file - (org-export-to-file 'html output-file))) - (_ (ennu-copy file 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-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 ennu-index-filename (filename-prefix tongue &optional extension page-number) - (let ((extension (if extension (concat "." extension) ""))) - (ennu-add-tongue-suffix - (if page-number - (format "%s-%s%s" filename-prefix page-number extension) - (concat filename-prefix extension)) - tongue))) - -(defun ennu-publish-index (filename-prefix title posts-per-page posts) - (let* ((tongue (ennu-post-language (first posts))) - (number-of-pages (ceiling (length posts) posts-per-page)) - (page-numbers (number-sequence 1 number-of-pages))) - (ennu-make-operation - :inputs (seq-map 'ennu-post-filename posts) - :outputs (cons (ennu-add-tongue-suffix (format "%s.html" filename-prefix) tongue) - (seq-map (apply-partially 'ennu-index-filename filename-prefix tongue "html") - page-numbers)) - :publish - (lambda (home-page &rest output-files) - (let ((system-time-locale (map-elt (ennu-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" (ennu-post-slug post))) - (insert (format-time-string "/%b %e, %Y/\n\n" (ennu-post-date post))) - (when-let ((thumbnail (ennu-post-thumbnail post))) - (insert (format "[[thumbnail:%s]]\n\n" thumbnail))) - (when-let ((summary (ennu-post-summary post))) - (insert summary) - (insert "\n\n")) - (when-let ((tags (ennu-post-tags post))) - (insert "Tags: ") - (insert - (string-join - (seq-map (lambda (tag) - (format "[[tag:%s][%s]]" (ennu-add-tongue-suffix tag tongue) tag)) - tags) - ", ")) - (insert "\n\n"))) - posts) - (unless (= page-number 1) - (insert (format "[[./%s][Newer posts]]\n" - (ennu-index-filename (file-name-nondirectory filename-prefix) - tongue nil (1- page-number))))) - (unless (= page-number number-of-pages) - (insert (format "[[./%s][Older posts]]\n" - (ennu-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 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 rights posts) - (ennu-make-operation - :inputs (seq-map 'ennu-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 ,(ennu--absolute-uri "")) - (title ,title) - (updated ,(ennu--atom-date (ennu-post-date (first posts)))) - (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) - ,@(seq-map 'ennu--feed-entry posts)))))))) - -(defun ennu--feed-entry (post) - (let ((link (ennu--absolute-uri (ennu--org-output-filename - (ennu-post-filename post))))) - `(entry (id ,link) - (title :xml:lang ,(ennu-post-language post) ,(ennu-post-title post)) - (updated ,(ennu--atom-date (ennu-post-date post))) - ,@(when org-export-with-author - `((author - (name ,(ennu-post-author post)) - (email ,user-mail-address)))) - (content :type "html" :xml:lang ,(ennu-post-language post) - ,(ennu-with-file-contents (ennu-post-filename post) - (org-export-as 'ennu-html nil nil t))) - (link :rel "alternate" :href ,link) - ,@(seq-map (lambda (tag) `(category :term ,tag)) - (ennu-post-tags post))))) - -(defun ennu-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 ennu-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) - 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) - (ennu-make-operation - :inputs (list image) - :outputs (seq-map (apply-partially 'ennu-image-output-filename image) - widths) - :publish - (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) - (ennu-make-operation - :inputs (list file) - :outputs (list file) - :publish (apply-partially 'ennu-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 ennu-mkdir-p (directory) - (make-directory directory t)) - -(defun ennu-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 ennu--filter-map (function sequence) - (seq-filter 'identity (seq-map function sequence))) - -(defun ennu--do-operation (temporary-directory operation) - (let* ((expand (lambda (directory file) - (expand-file-name file directory))) - (inputs (ennu-operation-inputs operation)) - (outputs (ennu-operation-outputs operation)) - (absolute-outputs - (seq-map (apply-partially expand temporary-directory) - outputs)) - (previous-outputs - (seq-map (apply-partially expand (ennu-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 'ennu-copy previous-outputs absolute-outputs)) - (t (message "Publishing %s to %s" inputs outputs) - (seq-do 'ennu-mkdir-p - (seq-uniq - (seq-map 'file-name-directory absolute-outputs))) - (apply (ennu-operation-publish operation) absolute-outputs))))) - -(defun ennu-publish-static-file (file) - (ennu-make-operation - :inputs (list file) - :outputs (list file) - :publish (apply-partially 'ennu-copy file))) - -(defun ennu-publish-link (link) - (pcase link - (`("image" . ,path) - (list - (ennu-publish-image - (list (ennu-setting :default-image-width) - (ennu-setting :image-link-width)) - (ennu--expand-relative path (ennu-setting :images-directory))))) - (`("static" . ,path) - (list - (ennu-publish-copy (ennu--expand-relative path (ennu-setting :static-directory))))) - (`("video" . ,path) - (list - (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))))))) - -(defmacro ennu-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 ennu-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 "ennu" t))) - (chmod ,temporary-directory #o755) - (unwind-protect - (progn ,@body) - (delete-directory ,temporary-directory t)))) - -(defun ennu-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 ennu-publish () - (interactive) - (let ((make-backup-files nil) - (blog-title (ennu-setting :blog-title)) - (posts-per-page (ennu-setting :index-posts-per-page))) - (ennu-with-current-directory (ennu-setting :working-directory) - (ennu-with-temporary-directory temporary-directory - (seq-do - (apply-partially 'ennu--do-operation temporary-directory) - (append - (let ((posts (ennu-posts (ennu-setting :posts-directory)))) - (append - ;; Publish posts - (seq-mapcat (pcase-lambda (`(,translation-group . ,posts)) - (ennu-publish-post posts)) - (seq-group-by 'ennu-post-translation-group posts)) - ;; Publish feed - (list (ennu-publish-feed (ennu-setting :atom-feed-file) - blog-title - (ennu-setting :blog-license) - (seq-take posts (ennu-setting :atom-feed-number-of-posts)))) - ;; Publish indices - (seq-map - (pcase-lambda (`(,tongue . ,posts)) - (ennu-publish-index "index" blog-title posts-per-page posts)) - (seq-group-by 'ennu-post-language posts)) - (seq-mapcat - (pcase-lambda (`(,tag . ,posts)) - (seq-map - (pcase-lambda (`(,tongue . ,posts)) - (ennu-publish-index - (ennu--expand-relative tag (ennu-setting :tag-directory)) - tag posts-per-page posts)) - (seq-group-by 'ennu-post-language posts))) - (ennu-many-to-many-group-by 'ennu-post-tags 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 (ennu--filter-map 'ennu-post-thumbnail posts)))))) - ;; Publish other files - (when-let ((other-files-directory (ennu-setting :other-files-directory))) - (seq-map (apply-partially 'ennu-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 (ennu-setting :output-directory))) - (delete-directory output t) - (rename-file temporary-directory output t)))))) - -;;; Server -;;; -;;; Test HTTP server to serve the blog locally - -(defun ennu-server-start () - (interactive) - (setq httpd-root (expand-file-name (ennu-setting :output-directory) - (ennu-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 "Ennu web server listening at http://localhost:%d" httpd-port)) - -(defun ennu-server-stop () - (interactive) - (httpd-stop) - (message "Ennu web server stopped")) - -(provide 'ennu) |