;; -*- lexical-binding: t -*- (require 'ennu-html) (require 'ennu-image) (require 'ox) (require 'seq) (require 'cl) (require 'memoize) (defvar ennu-version "0.1.0" "Ennu version string") (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 (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-publish-index (filename-prefix tongue title subtitle posts-per-page posts) (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))) (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 (format "#+LANGUAGE: %s\n" tongue)) (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 (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 '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 ,(format "Emacs %d.%d Org-mode %s ennu %s" emacs-major-version emacs-minor-version (org-version) ennu-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 () (interactive) (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)