aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorArun Isaac2019-08-20 23:17:35 +0530
committerArun Isaac2019-08-20 23:17:35 +0530
commit24cba52bfe4e92d2e7082f28d9ae7fe788ef2701 (patch)
tree18d0322c23c942f74cd4aa2ccd43b8bb481f0c8b
downloadennum-24cba52bfe4e92d2e7082f28d9ae7fe788ef2701.tar.gz
ennum-24cba52bfe4e92d2e7082f28d9ae7fe788ef2701.tar.lz
ennum-24cba52bfe4e92d2e7082f28d9ae7fe788ef2701.zip
Initial commit
-rw-r--r--ennu-html.el86
-rw-r--r--ennu-image.el55
-rw-r--r--ennu.el406
3 files changed, 547 insertions, 0 deletions
diff --git a/ennu-html.el b/ennu-html.el
new file mode 100644
index 0000000..d2c4b76
--- /dev/null
+++ b/ennu-html.el
@@ -0,0 +1,86 @@
+;; -*- lexical-binding: t -*-
+
+(require 'ox)
+(require 'subr-x)
+(require 'xmlgen)
+
+(defun expand-file-name* (name default-directory)
+ (expand-file-name name (concat "/" default-directory)))
+
+(org-export-define-derived-backend 'ennu-html 'html
+ :options-alist
+ '((:html-inline-image-rules
+ nil nil '(("image" . "\\.\\(jpeg\\|jpg\\|png\\|gif\\|svg\\)\\'")) t)
+ (:summary "SUMMARY" nil nil t)
+ (:thumbnail "THUMBNAIL" nil nil t)))
+
+;; TODO: Pass title through org-export-data-with-backend or something
+;; similar in order to export org syntax in title
+(defun ennu-export-post (path desc backend)
+ (let ((post (concat (expand-file-name path (ennu-setting :posts-directory))
+ ".org")))
+ (xmlgen `(a :href ,(expand-file-name*
+ path (ennu-setting :posts-directory))
+ ,(or desc (plist-get (ennu-post-metadata post) :title))))))
+
+(org-link-set-parameters
+ "post" :export 'ennu-export-post)
+
+(defun ennu-export-image (path desc backend)
+ (let ((img `(img :src ,(expand-file-name*
+ (ennu-image-output-filename
+ path (ennu-setting :default-image-width))
+ (ennu-setting :images-directory)))))
+ (xmlgen (if (ennu-setting :image-link-width)
+ `(a :href ,(expand-file-name*
+ (ennu-image-output-filename
+ path (ennu-setting :image-link-width))
+ (ennu-setting :images-directory))
+ ,img)
+ img))))
+
+(org-link-set-parameters
+ "image" :export 'ennu-export-image)
+
+(defun ennu-export-thumbnail (path desc backend)
+ (xmlgen
+ `(img :src ,(expand-file-name*
+ (ennu-image-output-filename
+ path (ennu-setting :thumbnail-image-width))
+ (ennu-setting :images-directory)))))
+
+(org-link-set-parameters
+ "thumbnail" :export 'ennu-export-thumbnail)
+
+(defun ennu-export-video (path desc backend)
+ (let ((video-directory (ennu-setting :video-directory)))
+ (xmlgen
+ `(video :src ,(expand-file-name* path video-directory)
+ :poster ,(expand-file-name* (ennu-video-poster path) video-directory)
+ :preload "none"
+ :controls ""))))
+
+(org-link-set-parameters
+ "video" :export 'ennu-export-video)
+
+(defun ennu-export-static (path desc backend)
+ (xmlgen
+ `(a :href ,(expand-file-name* path (ennu-setting :static-directory))
+ ,desc)))
+
+(org-link-set-parameters
+ "static" :export 'ennu-export-static)
+
+(org-link-set-parameters
+ "tangle" :export 'ennu-export-static)
+
+(defun ennu-export-tag (tag desc backend)
+ (xmlgen
+ `(a :href ,(expand-file-name* (concat tag ".html")
+ (ennu-setting :tag-directory))
+ ,(or desc tag))))
+
+(org-link-set-parameters
+ "tag" :export 'ennu-export-tag)
+
+(provide 'ennu-html)
diff --git a/ennu-image.el b/ennu-image.el
new file mode 100644
index 0000000..34c3e7e
--- /dev/null
+++ b/ennu-image.el
@@ -0,0 +1,55 @@
+;; -*- lexical-binding: t -*-
+
+(require 'image)
+(require 'seq)
+
+;; Check if all necessary image types are supported
+(seq-do (lambda (image-type)
+ (unless (image-type-available-p image-type)
+ (lwarn '(ennu) :error "`%s' image type not supported" image-type)))
+ '(jpeg png svg))
+
+;; Check for existence of external image processing utilities
+(seq-do (lambda (external-program)
+ (unless (executable-find external-program)
+ (lwarn '(ennu) :error "`%s' not found" external-program)))
+ '("convert" "identify" "jpegtran" "optipng"))
+
+(defun ennu-image-resize-image (infile-path outfile-path width)
+ "A simple shell wrapper around ImageMagick's convert"
+ (ennu-image--assert-file-exists infile-path)
+ (cl-case (image-type infile-path)
+ (svg
+ (copy-file infile-path outfile-path t))
+ (otherwise
+ (call-process "convert" nil nil nil
+ infile-path "-resize" (format "%d>" width) outfile-path)))
+ outfile-path)
+
+(defun ennu-image-optimize-image (image-path)
+ "A simple shell wrapper around jpegtran and optipng"
+ (ennu-image--assert-file-exists image-path)
+ (cl-case (image-type image-path)
+ (jpeg
+ (call-process "jpegtran" nil nil nil "-optimize"
+ "-progressive" "-copy" "none"
+ "-outfile" image-path image-path))
+ (png
+ (call-process "optipng" nil nil nil image-path)))
+ image-path)
+
+(defun ennu-image-get-width (image-path)
+ (ennu-image--assert-file-exists image-path)
+ (cl-case (image-type image-path)
+ (svg 1e+INF)
+ (otherwise
+ (with-temp-buffer
+ (call-process "identify" nil t nil
+ "-format" "%w" image-path)
+ (string-to-number (buffer-string))))))
+
+(defun ennu-image--assert-file-exists (path)
+ (unless (file-exists-p path)
+ (error "File %s does not exist" path)))
+
+(provide 'ennu-image)
diff --git a/ennu.el b/ennu.el
new file mode 100644
index 0000000..2e54938
--- /dev/null
+++ b/ennu.el
@@ -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)