summaryrefslogtreecommitdiff
path: root/ennu.el
diff options
context:
space:
mode:
Diffstat (limited to 'ennu.el')
-rw-r--r--ennu.el524
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)