diff options
Diffstat (limited to 'ennu.el')
| -rw-r--r-- | ennu.el | 406 |
1 files changed, 406 insertions, 0 deletions
@@ -0,0 +1,406 @@ +;; -*- lexical-binding: t -*- + +(require 'ennu-html) +(require 'ennu-image) +(require 'ox) +(require 'seq) +(require 'cl) +(require 'memoize) + +(defmacro ennu--with-file-contents (file &rest 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 (post) + ;; TODO: Tangle post + `((,post) + (,(ennu--org-output-filename post)) + ,(lambda (output-file) + (ennu--with-file-contents post + (org-export-to-file 'ennu-html output-file)) + ;; (when-let (tangle-dir (or (plist-get posts-plist :valai-tangle-directory) + ;; valai-tangle-directory)) + ;; (dolist (tangled-file + ;; (org-babel-tangle-file post-path)) + ;; (when (member (file-name-extension tangled-file) '("sh" "py")) + ;; (chmod tangled-file (string-to-number "755" 8))) + ;; (make-directory tangle-dir t) + ;; (rename-file tangled-file + ;; (expand-file-name (file-name-nondirectory tangled-file) + ;; tangle-dir) + ;; t))) + ))) + +(defun ennu-publish-page (pages-directory page) + `((,page) + (,(ennu--org-output-filename + (string-remove-prefix + (file-name-as-directory pages-directory) + page))) + ,(lambda (output-file) + (ennu--with-file-contents page + (org-export-to-file 'html 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-post-thumbnail (post) + (or (plist-get (ennu-post-metadata post) :thumbnail) + (seq-some (lambda (link) + (pcase link + (`("image" . ,path) path) + (`("video" . ,path) (ennu-video-poster path)))) + (ennu-post-links post)))) + +(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))))) + +(defun ennu-index-filename (filename-prefix tongue extension &optional page-number) + (ennu-add-tongue-suffix + (if page-number + (format "%s-%s.%s" + (file-name-nondirectory filename-prefix) + page-number + extension) + (format "%s.%s" (filename-nondirectory filename-prefix) extension)) + tongue)) + +(defun ennu-publish-index (filename-prefix tongue title subtitle posts-per-page posts) + (let* ((number-of-pages (ceiling (length posts) posts-per-page)) + (page-numbers (number-sequence 1 number-of-pages))) + `(,posts + ,(cons (ennu-add-tongue-suffix (format "%s.html" filename-prefix) tongue) + (seq-map (apply-partially 'ennu-index-filename filename-prefix tongue "html") + page-numbers)) + ,(lambda (home-page &rest output-files) + (seq-mapn + (lambda (posts page-number output-file) + (with-temp-buffer + (insert (format "#+TITLE: %s\n" title subtitle)) + (insert "#+OPTIONS: num:nil toc:nil\n\n") + (when subtitle + (insert (format "%s\n\n" subtitle))) + (seq-do (lambda (post) + (let ((metadata (ennu-post-metadata post))) + (insert (format "* [[post:%s]]\n" (file-name-base post))) + (insert (format-time-string + "/%b %e, %Y/\n\n" + (plist-get metadata :date))) + (when-let ((thumbnail (ennu-post-thumbnail post))) + (insert (format "[[thumbnail:%s]]\n\n" thumbnail))) + (when-let ((summary (plist-get metadata :summary))) + (insert summary) + (insert "\n\n")) + (when-let ((tags (plist-get metadata :filetags))) + (insert "Tags: ") + (insert + (string-join (seq-map (apply-partially 'format "[[tag:%s]]") + tags) + ", ")) + (insert "\n\n")))) + posts) + (unless (= page-number 1) + (insert (format "[[./%s][Newer posts]]\n" + (ennu-index-filename filename-prefix tongue "org" (1- page-number))))) + (unless (= page-number number-of-pages) + (insert (format "[[./%s][Older posts]]\n" + (ennu-index-filename filename-prefix tongue "org" (1+ page-number))))) + (org-export-to-file 'ennu-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 subtitle rights posts) + `(,posts + (,feed-file) + ,(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 (plist-get (ennu-post-metadata (first posts)) :date))) + (link :rel "self" :href ,(ennu--absolute-uri feed-file)) + (generator + ;; TODO: Change this generator + ,(format "Emacs %d.%d Org-mode %s ennu" + emacs-major-version emacs-minor-version (org-version))) + (rights ,rights) + ,@(when subtitle + `((subtitle ,subtitle))) + ,@(seq-map 'ennu--feed-entry posts)))))))) + +(defun ennu--feed-entry (post) + (let* ((metadata (ennu-post-metadata post)) + (lang (plist-get metadata :lang)) + (link (ennu--absolute-uri (ennu--org-output-filename post)))) + `(entry (id ,link) + (title :xml:lang ,lang ,(plist-get metadata :title)) + (updated ,(ennu--atom-date (plist-get metadata :date))) + (author + (name ,(plist-get metadata :author)) + (email ,user-mail-address)) + (content :type "html" :xml:lang ,lang + ,(ennu--with-file-contents post + (org-export-as 'ennu-html nil nil t))) + (link :rel "alternate" :href ,link) + ,@(seq-map (lambda (tag) `(category :term ,tag)) + (plist-get metadata :filetags))))) + +(defun ennu-setting (property) + (pcase property + (:blog-scheme + (or (plist-get ennu-blog :blog-scheme) + "https")) + (:atom-feed-file + (or (plist-get ennu-blog :atom-feed-file) + "blog.atom")) + (:index-posts-per-page + (or (plist-get ennu-blog :index-posts-per-page) + 12)) + (:atom-feed-number-of-posts + (or (plist-get ennu-blog :atom-feed-number-of-posts) + 12)) + (:thumbnail-image-width + (or (plist-get ennu-blog :thumbnail-image-width) + 320)) + (:default-image-width + (or (plist-get ennu-blog :default-image-width) + 640)) + (:image-link-width + (or (plist-get ennu-blog :image-link-width) + 1024)) + ((or :blog-domain :blog-license :blog-title + :images-directory :output-directory :posts-directory + :static-directory :tag-directory :video-directory) + (or (plist-get ennu-blog property) + (user-error "Property %s not defined" property))) + ((or :blog-subtitle :pages-directory :unattached-static-files) + (plist-get 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) + `((,image) + ,(seq-map (apply-partially 'ennu-image-output-filename image) + widths) + ,(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) + `((,file) (,file) ,(apply-partially 'copy-file file))) + +(defun ennu-post-links (post) + (ennu--with-file-contents post + (org-element-map (org-element-parse-buffer) '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)))))))))) + +(defun plist-put* (plist &rest key-value-pairs) + (pcase key-value-pairs + (`(,key ,value) + (plist-put plist key value)) + (`(,key ,value . ,tail) + (apply 'plist-put* (plist-put plist key value) tail)))) + +(defun ennu-post-metadata (post) + (ennu--post-metadata-memoized + post (file-attribute-modification-time + (file-attributes post)))) + +(defmemoize ennu--post-metadata-memoized (post last-modified) + (ennu--with-file-contents post + (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) + (plist-put* + metadata + :title (funcall export (first (plist-get metadata :title))) + :date (org-timestamp-to-time (first (plist-get metadata :date))) + :author (funcall export (first (plist-get metadata :author))))))) + +(defvar ennu-mandatory-metadata + (list :title :date)) + +(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." + (if (file-directory-p source) + (copy-directory source destination) + (make-directory (file-name-directory destination) t) + (copy-file source destination))) + +(defun ennu--do-operation (temporary-directory operation) + (let ((expand (lambda (directory file) + (expand-file-name file directory)))) + (pcase operation + (`(,input-files ,output-files ,publish) + (let ((absolute-output-files + (seq-map (apply-partially expand temporary-directory) + output-files)) + (previous-output-files + (seq-map (apply-partially expand (ennu-setting :output-directory)) + output-files))) + (cond + ((and (seq-every-p 'file-exists-p previous-output-files) + (file-newer-than-file-p (newest-file previous-output-files) + (newest-file input-files))) + (message "Skipping publishing %s to %s" input-files output-files) + (seq-mapn 'ennu-copy previous-output-files absolute-output-files)) + (t (message "Publishing %s to %s" input-files output-files) + (seq-do 'ennu-mkdir-p + (seq-uniq + (seq-map 'file-name-directory absolute-output-files))) + (apply publish absolute-output-files)))))))) + +(defun ennu--later-post (post1 post2) + (time-less-p (plist-get (ennu-post-metadata post2) :date) + (plist-get (ennu-post-metadata post1) :date))) + +(defun ennu-publish-static-file (file) + `((,file) (,file) ,(apply-partially 'copy-file file))) + +(defun ennu-posts (posts-directory) + (sort (file-expand-wildcards + (concat (file-name-as-directory + (ennu-setting :posts-directory)) + "*.org")) + 'ennu--later-post)) + +(defun ennu-publish-link (link) + (pcase link + (`("image" . ,path) + (ennu-publish-image + (list (ennu-setting :default-image-width) + (ennu-setting :image-link-width)) + (ennu--expand-relative path (ennu-setting :images-directory)))) + (`("static" . ,path) + (ennu-publish-copy (ennu--expand-relative path (ennu-setting :static-directory)))) + (`("video" . ,path) + (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)))))) + +(defun ennu-post-tags (post) + (plist-get (ennu-post-metadata post) :filetags)) + +(defun ennu-post-tongue (post) + (plist-get (ennu-post-metadata post) :language)) + +(defun ennu-publish () + (let ((make-backup-files nil) + (blog-title (ennu-setting :blog-title)) + (blog-subtitle (ennu-setting :blog-subtitle)) + (posts-per-page (ennu-setting :index-posts-per-page))) + (let ((temporary-directory (make-temp-file "ennu" t))) + (unwind-protect + (progn + (seq-do + (apply-partially 'ennu--do-operation temporary-directory) + (append + (let* ((posts (ennu-posts (ennu-setting :posts-directory))) + (tags (seq-uniq (seq-mapcat 'ennu-post-tags posts))) + (tongues (seq-uniq (seq-map 'ennu-post-tongue posts)))) + (append + ;; Publish posts + (seq-map 'ennu-publish-post posts) + ;; Publish feed + (list (ennu-publish-feed (ennu-setting :atom-feed-file) + blog-title blog-subtitle + (ennu-setting :blog-license) + (seq-take posts (ennu-setting :atom-feed-number-of-posts)))) + ;; Publish indices + (seq-map + (lambda (tongue) + (ennu-publish-index + "index" tongue blog-title blog-subtitle posts-per-page + (seq-filter (lambda (post) + (string= tongue (ennu-post-tongue post))) + posts))) + tongues) + (seq-map + (lambda (tag) + (let ((posts (seq-filter (lambda (post) + (member tag (ennu-post-tags post))) + posts))) + (ennu-publish-index + (ennu--expand-relative tag (ennu-setting :tag-directory)) + (ennu-post-tongue (first posts)) tag "" posts-per-page posts))) + tags) + ;; Publish links + (seq-map 'ennu-publish-link + (seq-uniq (seq-mapcat 'ennu-post-links 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 (seq-filter 'identity (seq-map 'ennu-post-thumbnail posts))))))) + ;; Publish pages + (when-let ((pages-directory (ennu-setting :pages-directory))) + (seq-map (apply-partially 'ennu-publish-page pages-directory) + (seq-map (apply-partially 'string-remove-prefix + (file-name-as-directory (expand-file-name default-directory))) + (directory-files-recursively pages-directory "\\.org$")))) + ;; Publish unattached static files + (seq-map 'ennu-publish-static-file + (ennu-setting :unattached-static-files)))) + ;; Replace old output directory + (let ((output (ennu-setting :output-directory))) + (delete-directory output t) + (rename-file temporary-directory output t))) + (delete-directory temporary-directory t))))) + +(provide 'ennu) |