2017-11-12 23:48:21 +01:00
|
|
|
;;; blog.el --- A simple org-mode & elnode blog software.
|
|
|
|
;;; -*- lexical-binding: t; -*-
|
|
|
|
|
2017-11-13 18:40:59 +01:00
|
|
|
(require 'dash)
|
2017-11-12 23:48:21 +01:00
|
|
|
(require 'elnode)
|
|
|
|
(require 'f)
|
2017-11-13 18:40:59 +01:00
|
|
|
(require 'ht)
|
2017-11-12 23:48:21 +01:00
|
|
|
|
2017-11-13 00:16:26 +01:00
|
|
|
;; Definition of customization options
|
|
|
|
|
|
|
|
(defgroup elblog nil
|
|
|
|
"Configuration for the Emacs Lisp blog software"
|
|
|
|
:link '(url-link "https://github.com/tazjin/elblog"))
|
|
|
|
|
|
|
|
(defcustom elblog-port 8010
|
|
|
|
"Port to run elblog's HTTP server on"
|
|
|
|
:group 'elblog
|
|
|
|
:type 'integer)
|
|
|
|
|
|
|
|
(defcustom elblog-host "localhost"
|
|
|
|
"Host for elblog's HTTP server to listen on"
|
|
|
|
:group 'elblog
|
|
|
|
:type 'string)
|
|
|
|
|
2017-11-13 16:49:41 +01:00
|
|
|
(defcustom elblog-title "Elblog"
|
|
|
|
"Title text for this elblog instance"
|
|
|
|
:group 'elblog
|
|
|
|
:type 'string)
|
|
|
|
|
2017-11-13 18:40:59 +01:00
|
|
|
(defcustom elblog-article-directory nil
|
|
|
|
"Directory in which elblog articles are stored"
|
|
|
|
:group 'elblog
|
|
|
|
:type 'string)
|
|
|
|
|
2017-11-13 22:45:30 +01:00
|
|
|
(defcustom elblog-additional-routes '()
|
|
|
|
"Additional Elnode routes to register in the Elblog instance"
|
|
|
|
:group 'elblog
|
|
|
|
:type '(alist :key-type regexp :value-type function))
|
|
|
|
|
2017-11-13 18:40:59 +01:00
|
|
|
;; Declare user-configurable variables needed at runtime.
|
|
|
|
|
|
|
|
(defvar elblog-articles (ht-create)
|
|
|
|
"A hash-table of blog articles. This is used for looking up articles from
|
|
|
|
URL fragments as well as for rendering the index.")
|
|
|
|
|
2017-11-13 16:49:41 +01:00
|
|
|
;; HTML templating setup
|
|
|
|
|
|
|
|
(defun template-preamble ()
|
|
|
|
"Templates the preamble snippet with the correct blog title."
|
|
|
|
(format (f-read-text "preamble.html") elblog-title))
|
|
|
|
|
2017-11-13 00:57:20 +01:00
|
|
|
(defun configure-org-html-export ()
|
2017-11-13 16:42:29 +01:00
|
|
|
"Configure org-mode settings for elblog's HTML templating to work correctly."
|
2017-11-13 00:57:20 +01:00
|
|
|
(setq org-html-postamble t)
|
|
|
|
(setq org-html-doctype "html5")
|
|
|
|
(setq org-html-head-include-scripts nil)
|
|
|
|
(setq org-html-style-default (f-read-text "blog.css"))
|
2017-11-13 16:49:41 +01:00
|
|
|
(setq org-html-preamble-format `(("en" ,(template-preamble))))
|
2017-11-13 00:57:20 +01:00
|
|
|
(setq org-html-postamble-format `(("en" ,(f-read-text "postamble.html")))))
|
|
|
|
|
2017-11-13 00:16:26 +01:00
|
|
|
;; Article fetching & rendering functions
|
|
|
|
|
2017-11-13 18:40:59 +01:00
|
|
|
(defun render-org-buffer (input-buffer &optional force)
|
2017-11-12 23:48:21 +01:00
|
|
|
"Renders an org-mode buffer as HTML and returns the name of the output buffer."
|
2017-11-13 18:40:59 +01:00
|
|
|
(letrec ((output-buffer (concat (buffer-name input-buffer) "-rendered"))
|
2017-11-12 23:48:21 +01:00
|
|
|
;; Don't re-render articles unless forced.
|
|
|
|
(must-render (or force
|
|
|
|
(not (get-buffer output-buffer)))))
|
|
|
|
(if (and input-buffer must-render)
|
|
|
|
(with-current-buffer input-buffer
|
|
|
|
(org-export-to-buffer 'html output-buffer nil nil t)))
|
|
|
|
(if input-buffer output-buffer nil)))
|
|
|
|
|
|
|
|
(defun get-buffer-string (buffer)
|
|
|
|
"Returns the contents of the specified buffer as a string."
|
|
|
|
(with-current-buffer (get-buffer buffer)
|
|
|
|
(buffer-string)))
|
|
|
|
|
|
|
|
(defvar-local article-not-found
|
|
|
|
'(404 . "<html><body><p>Oh no, the article was not found.</p></body></html>"))
|
|
|
|
|
|
|
|
(defvar-local text-html '("Content-Type" . "text/html"))
|
|
|
|
|
|
|
|
(defun render-article (article)
|
|
|
|
"Renders an article, if it exists."
|
2017-11-13 18:40:59 +01:00
|
|
|
(letrec ((rendered (-some->>
|
|
|
|
(ht-get elblog-articles article)
|
|
|
|
(concat elblog-article-directory)
|
|
|
|
(find-file)
|
|
|
|
(render-org-buffer))))
|
|
|
|
(if rendered `(200 . ,(get-buffer-string rendered))
|
2017-11-12 23:48:21 +01:00
|
|
|
article-not-found)))
|
|
|
|
|
|
|
|
(defun blog-post-handler (httpcon)
|
|
|
|
"This handler servers a blog post from the configured blog post directory."
|
|
|
|
(let ((response (render-article (elnode-http-mapping httpcon 1))))
|
|
|
|
(elnode-http-start httpcon (car response) text-html)
|
|
|
|
(elnode-http-return httpcon (cdr response))))
|
|
|
|
|
2017-11-13 00:16:26 +01:00
|
|
|
;; Web server implementation
|
|
|
|
|
2017-11-13 22:45:30 +01:00
|
|
|
(defvar elblog-routes
|
|
|
|
'(("^.*//\\(.*\\)" . blog-post-handler))
|
|
|
|
"The default routes available in elblog. They can be extended by the user
|
|
|
|
by setting the elblog-additional-routes customize option.")
|
2017-11-12 23:48:21 +01:00
|
|
|
|
|
|
|
(defun elblog-handler (httpcon)
|
2017-11-13 22:45:30 +01:00
|
|
|
(elnode-hostpath-dispatcher
|
|
|
|
httpcon
|
|
|
|
(-concat elblog-additional-routes elblog-routes)))
|
2017-11-12 23:48:21 +01:00
|
|
|
|
2017-11-12 23:56:27 +01:00
|
|
|
(defun start-elblog ()
|
|
|
|
(interactive)
|
2017-11-13 00:57:20 +01:00
|
|
|
(configure-org-html-export)
|
2017-11-12 23:56:27 +01:00
|
|
|
(elnode-start 'elblog-handler
|
2017-11-13 00:16:26 +01:00
|
|
|
:port elblog-port
|
|
|
|
:host elblog-host))
|
2017-11-12 23:56:27 +01:00
|
|
|
|
|
|
|
(defun stop-elblog ()
|
|
|
|
(interactive)
|
2017-11-13 00:16:26 +01:00
|
|
|
(elnode-stop elblog-port))
|
2017-11-13 16:42:29 +01:00
|
|
|
|
|
|
|
(provide 'elblog)
|