miniblog

Miniblog: A command-line static blog system in Common Lisp
Log | Files | Refs | README | LICENSE

commit bacd99dcb980281b7a575763510c61e092e881d0
parent c76060870e256c2a5623442aba9e24e80164a24b
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date:   Fri, 18 Sep 2020 14:04:36 -0700

Support for static pages!

There is now a parallel tree of pages that can be created outside the
post structure in the fashion of Wordpress or other heavier-duty
blogging platforms. See the README to get started!

Diffstat:
MREADME | 7+++++--
Mminiblog.asd | 7++++++-
Msrc/content.lisp | 211++++++++++++++++++++++++++++++++++++++++++++++++++-----------------------------
Msrc/db.lisp | 13+++++++++++--
Msrc/miniblog.lisp | 342+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++--------------
Msrc/packages.lisp | 17++++++++++-------
Dsrc/pagetemplate.lhtml | 105-------------------------------------------------------------------------------
Dsrc/template.lhtml | 119-------------------------------------------------------------------------------
Atemplates/header.lhtml | 5+++++
Atemplates/html-head.lhtml | 31+++++++++++++++++++++++++++++++
Atemplates/left-column.lhtml | 24++++++++++++++++++++++++
Atemplates/nav.lhtml | 36++++++++++++++++++++++++++++++++++++
Atemplates/pagetemplate.lhtml | 31+++++++++++++++++++++++++++++++
Rsrc/rss.lxml -> templates/rss.lxml | 0
Atemplates/template.lhtml | 45+++++++++++++++++++++++++++++++++++++++++++++
15 files changed, 620 insertions(+), 373 deletions(-)

diff --git a/README b/README @@ -45,10 +45,13 @@ $ ~/miniblog.lisp -h --list -l boolean List posts --start -s integer When listing posts, first post to list (default 0) -n integer When listing posts, max number of posts to list (default all) + --page -p boolean This parameter specifies operations to be done on pages, rather than posts. EG saying -a -p means you intend to add a new page rather than a new post. Page IDs are in a separate namespace from post IDs. + --move -m integer Move a page from its current path to a new one. + --uri -u string When adding a new page, this specifies the path to the new page in relative URI format. For instance, "-a -p -u foo/bar" would specify that the new page should be created with the name bar as a child of page foo. This is only valid if root page foo actually exists. This isalso used in conjunction with -m to specify the target path for the page being moved, with the same restriction. A leading / will be ignored so "-u /foo/bar/baz" and "-u foo/bar/baz" mean the same thing. + --children-to-root -c boolean When deleting a page, normally child pages of the page being deleted will be moved to the parent page of the deleted page. If -c is specified, the pages will instead be moved to the root. --regen-all -r boolean When adding or editing, regenerate all pages instead of just those miniblog thinks have changed. Can also be invoked standalone to regenerate the HTML directly. - --help -h boolean This help information -By default, add and edit will use whatever editor you have specified in EDITOR, otherwise will fall back to vi. Posts are written in a convenient format: +By default, add and edit will use whatever editor you have specified in EDITOR, otherwise will fall back to vi. Posts (and pages) are written in a convenient format: [Title] diff --git a/miniblog.asd b/miniblog.asd @@ -11,6 +11,7 @@ into date-structured directories as a normal HTML." :author "DecayDJK <decaydjk@tilde.town>" :license "GPLv3 or later" :depends-on ("uiop" + "alexandria" "cl-fad" "cl-markdown" "cl-emb" @@ -26,7 +27,11 @@ into date-structured directories as a normal HTML." (:file "edit") (:file "db") (:file "content") - (:file "miniblog") + (:file "miniblog"))) + (:module "templates" + :components ((:static-file "html-head.lhtml") + (:static-file "header.lhtml") + (:static-file "left-column.lhtml") (:static-file "pagetemplate.lhtml") (:static-file "template.lhtml") (:static-file "rss.lxml"))) diff --git a/src/content.lisp b/src/content.lisp @@ -1,53 +1,61 @@ (in-package :miniblog.content) -(let ((this-file #.(or *compile-file-truename* *load-truename*))) +(let* ((this-file #.(or *compile-file-truename* *load-truename*)) + (src-dir (pathname-directory this-file)) + (templates-dir (append (butlast src-dir) '("templates")))) + (defparameter *templates-dir* (make-pathname :directory templates-dir)) (register-emb "default-template" (make-pathname :name "template" :type "lhtml" - :directory (pathname-directory this-file) + :directory templates-dir :defaults this-file)) (register-emb "default-page-template" (make-pathname :name "pagetemplate" :type "lhtml" - :directory (pathname-directory this-file) + :directory templates-dir :defaults this-file)) (register-emb "rss" (make-pathname :name "rss" :type "lxml" - :directory (pathname-directory this-file) + :directory templates-dir :defaults this-file))) (defun make-generator (&key title root-uri header links stylesheet) - (lambda (entries &key year month archive-date-list tz enable-rss) - (execute-emb - "default-template" - :env (list - :title title - :root-uri root-uri - :header header - :links links - :stylesheet stylesheet - :enable-rss enable-rss - :posts entries - :year year - :month month - :archive-date-list archive-date-list - :content-formatter (miniblog.format:make-content-formatter) - :short-date-formatter (miniblog.format:make-short-date-formatter (or tz *default-timezone*)) - :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*)))))) + (lambda (entries pages &key year month archive-date-list tz enable-rss) + (let ((*default-pathname-defaults* *templates-dir*)) + (execute-emb + "default-template" + :env (list + :title title + :root-uri root-uri + :header header + :links links + :stylesheet stylesheet + :enable-rss enable-rss + :posts entries + :year year + :month month + :pages pages + :archive-date-list archive-date-list + :content-formatter (miniblog.format:make-content-formatter) + :short-date-formatter (miniblog.format:make-short-date-formatter (or tz *default-timezone*)) + :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*))))))) (defun make-page-generator (&key title root-uri header links stylesheet) - (lambda (entry &key archive-date-list tz enable-rss) - (execute-emb - "default-page-template" - :env (list - :title title - :root-uri root-uri - :header header - :links links - :stylesheet stylesheet - :enable-rss enable-rss - :archive-date-list archive-date-list - :content-formatter (miniblog.format:make-content-formatter) - :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*)) - :post entry)))) + (lambda (entry path pages &key archive-date-list tz enable-rss) + (let ((*default-pathname-defaults* *templates-dir*)) + (execute-emb + "default-page-template" + :env (list + :title title + :root-uri root-uri + :header header + :links links + :stylesheet stylesheet + :enable-rss enable-rss + :pages pages + :post entry + :path path + :archive-date-list archive-date-list + :content-formatter (miniblog.format:make-content-formatter) + :long-date-formatter (miniblog.format:make-long-date-formatter (or tz *default-timezone*))))))) (defun strip-html-tags (content) (format nil "~{~A~}" @@ -61,26 +69,48 @@ copyright managing-editor webmaster category) (if (and title link description) (lambda (entries &key tz) - (execute-emb - "rss" - :env (list - :title title - :link link - :description description - :image-url image-url - :language language - :copyright copyright - :managing-editor managing-editor - :webmaster webmaster - :category category - :posts entries - :build-date (now) - :content-formatter (miniblog.format:make-content-formatter) - :content-stripper #'strip-html-tags - :rfc-822-date-formatter (miniblog.format:make-rfc-822-date-formatter (or tz *default-timezone*))))) + (let ((*default-pathname-defaults* *templates-dir*)) + (execute-emb + "rss" + :env (list + :title title + :link link + :description description + :image-url image-url + :language language + :copyright copyright + :managing-editor managing-editor + :webmaster webmaster + :category category + :posts entries + :build-date (now) + :content-formatter (miniblog.format:make-content-formatter) + :content-stripper #'strip-html-tags + :rfc-822-date-formatter (miniblog.format:make-rfc-822-date-formatter (or tz *default-timezone*)))))) (lambda (entries &key tz) (declare (ignore entries tz))))) +(defun get-page-by-path (path pages) + (labels ((get-page-name (name page-list) + (find-if #'(lambda (page) (string= name (getf page :name))) + page-list))) + (car (last (loop for path-elem in path + for curr-page = pages then next-page + for page-list = (getf curr-page :children) + for next-page = (get-page-name path-elem page-list) + when (null next-page) return nil + collect next-page))))) + +(defun get-page-id-by-path (path pages) + (getf (get-page-by-path path pages) :id)) + +(defun get-path-to-page (id pages-table) + (reverse (loop for next-id = id then (getf page :parent) + until (zerop next-id) + for page = (gethash next-id pages-table) + when (null page) return nil + collect (getf page :name)))) + (defun year-month-of-entry (entry &key tz) (if (not entry) (error "Entry cannot be nil") @@ -133,39 +163,68 @@ (mapcar #'get-year-month-pair-for-entry entries) :test #'year-month-pairs-equal-p))) -(defun gen-all (entries &key generator rss-generator tz) - "Generate a list of all monthly pages as well as the index and RSS feed" +(defun gen-all-pages (pages &key prefix all-pages archive-date-list generator tz enable-rss) + "Generate all pages in the tree rooted at PAGES. PREFIX may be supplied if this is a subtree, in which case ALL-PAGES should also be supplied so that the page nav can render correctly." + (labels ((with-paths (parent-path entries) + (mapcar #'(lambda (entry) + (cons entry + (append parent-path (cons (getf entry :name) nil)))) + entries)) + (gen-pages-recur (generated queue) + (if (= 0 (length queue)) + generated + (let* ((next-page (caar queue)) + (path (cdar queue)) + (next-page-content (gen-page next-page + path + (or all-pages pages) + :generator generator + :tz tz + :archive-date-list archive-date-list + :enable-rss enable-rss)) + (next-page-entry (list :page path next-page-content)) + (queue-rest (cdr queue)) + (queue-new (with-paths path (getf next-page :children)))) + (gen-pages-recur (append generated (cons next-page-entry nil)) + (append queue-rest queue-new)))))) + (gen-pages-recur nil (with-paths prefix (getf pages :children))))) + +(defun gen-all (entries pages &key generator page-generator rss-generator tz) + "Generate a list of all monthly pages and hierarchical pages as well as the index and RSS feed" (labels - ((gen-all-years (entries archive-date-list generator tz enable-rss) + ((gen-all-years (entries pages archive-date-list generator tz enable-rss) (let ((rest-entries (copy-list entries)) (content '())) (loop for year-month in archive-date-list do (let ((month-content (gen-month rest-entries (car year-month) (cdr year-month) + pages :enable-rss enable-rss :archive-date-list archive-date-list :generator generator :tz tz))) (setf rest-entries (cdr month-content)) - (setf content - (nconc content (list (car month-content)))))) + (setf content (cons (car month-content) content)))) content))) (let ((archive-date-list (get-archive-date-list entries tz)) (rss-content (gen-rss-feed entries :generator rss-generator :tz tz))) - (cons - (list :rss nil rss-content) - (cons - (list :index nil (gen-index entries - :enable-rss rss-content - :archive-date-list archive-date-list - :generator generator - :tz tz)) - (gen-all-years - entries archive-date-list - generator tz rss-content)))))) + (append (list + (list :rss nil rss-content) + (list :index nil (gen-index entries pages + :enable-rss rss-content + :archive-date-list archive-date-list + :generator generator + :tz tz))) + (gen-all-pages pages + :archive-date-list archive-date-list + :generator page-generator + :tz tz + :enable-rss rss-content) + (gen-all-years entries pages + archive-date-list generator tz rss-content))))) (defun top-ten (entries) (if (>= (length entries) 10) @@ -179,7 +238,7 @@ index-entries :tz tz))) -(defun gen-index (entries &key generator tz archive-date-list enable-rss) +(defun gen-index (entries pages &key generator tz archive-date-list enable-rss) "Generate the index (front page) with the latest ten posts" (if (not entries) (funcall (or generator (make-generator)) nil :tz tz) @@ -187,12 +246,12 @@ (get-archive-date-list entries tz))) (index-entries (top-ten entries))) (funcall (or generator (make-generator)) - index-entries + index-entries pages :enable-rss enable-rss :archive-date-list archive-date-list :tz tz)))) -(defun gen-month (entries year month &key generator tz archive-date-list enable-rss) +(defun gen-month (entries year month pages &key generator tz archive-date-list enable-rss) "Generate a page with all posts for the given year and month" (let ((archive-date-list (or archive-date-list (get-archive-date-list entries tz)))) @@ -205,7 +264,7 @@ (if month-entries (list year month (funcall (or generator (make-generator)) - month-entries + month-entries pages :year year :month month :enable-rss enable-rss @@ -214,18 +273,18 @@ nil) rest-entries)))) -(defun gen-post (entry &key generator tz archive-date-list enable-rss) +(defun gen-post (entry pages &key generator tz archive-date-list enable-rss) "Generate a single post page" (funcall (or generator (make-generator)) - (list entry) + (list entry) pages :enable-rss enable-rss :archive-date-list archive-date-list :tz tz)) -(defun gen-page (entry &key generator tz archive-date-list enable-rss) +(defun gen-page (entry path pages &key generator tz archive-date-list enable-rss) "Generate a single page" (funcall (or generator (make-page-generator)) - entry + entry path pages :enable-rss enable-rss :archive-date-list archive-date-list :tz tz)) diff --git a/src/db.lisp b/src/db.lisp @@ -164,6 +164,15 @@ (if entry (xform entry)))) +(defmacro with-page-id (page id &rest body) + "Takes a varname to hold the entry list and a page id + and executes the forms in body with the entry bound + to the specified entry variable" + `(let ((,page (miniblog.db:get-page ,id))) + (if ,page + (progn ,@body) + (format t "Page ID ~d not found~%" ,id)))) + (defun build-tree-table (dao-list &optional (xform #'xform)) (let ((entry-table (make-hash-table))) (labels ((build-tree (raw-entry) @@ -180,9 +189,9 @@ entry-table))) (defun get-pages (&optional (root-id 0)) - "Get all pages in a tree, or optionally a subtree starting from a given id" + "Get all pages in a tree, or optionally a subtree starting from a given id. Returns the subtree as the first return value and the (unconditionally) full hashtable as the second." (let* ((entry-table (build-tree-table (select-dao 'blog-pages)))) - (gethash root-id entry-table))) + (values (gethash root-id entry-table) entry-table))) (defun update-page (id name title content &key (username "nobody")) "Update page by id. Returns the updated page or nil if the id doesn't exist." diff --git a/src/miniblog.lisp b/src/miniblog.lisp @@ -13,7 +13,8 @@ ; If it's set to a string in .miniblogrc, will be ; translated with uiop:parse-native-namestring (defvar *root-uri*) ; Absolute or relative root uri, defaults to "~username" -(defvar *generator*) ; Function to generate content page, see content.lisp +(defvar *generator*) ; Function to generate post pages, see content.lisp +(defvar *page-generator*) ; Function to generate hierarchical pages, see content.lisp (defvar *rss-generator*) ; Function to generate RSS feed, see content.lisp ;;; The following are all used to populate RSS channel elements. @@ -38,6 +39,10 @@ :documentation "When listing posts, first post to list (default 0)") ((#\n) :type integer :optional t :documentation "When listing posts, max number of posts to list (default all)") + (("page" #\p) :type boolean :optional t :documentation "This parameter specifies operations to be done on pages, rather than posts. EG saying -a -p means you intend to add a new page rather than a new post. Page IDs are in a separate namespace from post IDs.") + (("move" #\m) :type integer :optional t :documentation "Move a page from its current path to a new one.") + (("uri" #\u) :type string :optional t :documentation "When adding a new page, this specifies the path to the new page in relative URI format. For instance, \"-a -p -u foo/bar\" would specify that the new page should be created with the name bar as a child of page foo. This is only valid if root page foo actually exists. This is also used in conjunction with -m to specify the target path for the page being moved, with the same restriction. A leading / will be ignored so \"-u /foo/bar/baz\" and \"-u foo/bar/baz\" mean the same thing.") + (("children-to-root" #\c) :type boolean :optional t :documentation "When deleting a page, normally child pages of the page being deleted will be moved to the parent page of the deleted page. If -c is specified, the pages will instead be moved to the root.") (("regen-all" #\r) :type boolean :optional t :documentation "When adding or editing, regenerate all pages instead of just those miniblog thinks have changed. Can also be invoked standalone to regenerate the HTML directly.") (("help" #\h) :type boolean :optional t :documentation "This help information"))) @@ -62,6 +67,12 @@ :header *blog-header* :links *blog-links* :stylesheet *blog-stylesheet*)) + (setf *page-generator* + (miniblog.content:make-page-generator :title *blog-title* + :root-uri *root-uri* + :header *blog-header* + :links *blog-links* + :stylesheet *blog-stylesheet*)) (setf *rss-generator* (miniblog.content:make-rss-generator :title *blog-title* :link *blog-link* @@ -81,6 +92,11 @@ (defun get-index-file () (get-index-file-for-path *public-html*)) +(defun get-page-path (path-list) + (merge-pathnames + (make-pathname :directory (append '(:relative "page") path-list)) + *public-html*)) + (defun get-rss-file () (merge-pathnames (make-pathname :name "rss" :type "xml") @@ -93,11 +109,38 @@ (format nil "~2,'0d" month))) *public-html*)) +(defun cleanup-path (filepath) + (format t "Cleaning ~S...~%" filepath) + (cond + ((and (string= (pathname-name filepath) "index") + (string= (pathname-type filepath) "html")) + (delete-file filepath)) + ((fad:directory-pathname-p filepath) + (handler-case (uiop:delete-empty-directory filepath) + (file-error (e) + (declare (ignore e)) + (format t "~cDirectory ~a not empty...~%" #\tab filepath)))) + (t (format t "~cUnrecognized file ~a, ignoring...~%" #\tab filepath)))) + +(defun flush-path (path) + (fad:walk-directory path #'cleanup-path + :directories :depth-first + :if-does-not-exist :ignore + :follow-symlinks nil)) + +(defun flush-page-path (path-list) + (flush-path (get-page-path path-list))) + +(defun flush-monthly-path (year month) + (flush-path (get-monthly-path year month))) + (defun get-path-and-description-for-entry (entry) (let* ((year (nth 0 entry)) (month (nth 1 entry))) (cond ((eql year :index) (values (get-index-file) "index")) + ((eql year :page) (values (get-index-file-for-path (get-page-path month)) + (str:join "/" month))) ((eql year :rss) (values (get-rss-file) "RSS feed")) (t (values (get-index-file-for-path (get-monthly-path year month)) @@ -131,11 +174,48 @@ :generator *generator* :tz *blog-timezone*))))) -(defun regenerate-all (entries) - (let ((all (miniblog.content:gen-all entries - :generator *generator* - :rss-generator *rss-generator* - :tz *blog-timezone*))) +(defun regenerate-page-and-parent-and-children (parent-path page-id pages) + (let* ((entries (miniblog.db:get-entries)) + (subtree-root (miniblog.content:get-page-by-path parent-path pages)) + (archive-date-list (miniblog.content:get-archive-date-list entries + *blog-timezone*)) + (rss-content (miniblog.content:gen-rss-feed entries + :generator *rss-generator* + :tz *blog-timezone*))) + (regenerate-file (list :page parent-path + (miniblog.content:gen-page subtree-root + parent-path + pages + :enable-rss rss-content + :generator *page-generator* + :tz *blog-timezone* + :archive-date-list archive-date-list))) + (loop for page in (getf subtree-root :children) + do (let ((path (append parent-path (list (getf page :name))))) + (regenerate-file (list :page + path + (miniblog.content:gen-page + page path pages + :enable-rss rss-content + :generator *page-generator* + :tz *blog-timezone* + :archive-date-list archive-date-list))))) + (let ((this-page (find-if #'(lambda (entry) (= page-id (getf entry :id))) (getf subtree-root :children)))) + (mapcar #'regenerate-file (miniblog.content:gen-all-pages this-page + :prefix parent-path + :all-pages pages + :enable-rss rss-content + :generator *page-generator* + :tz *blog-timezone* + :archive-date-list archive-date-list))))) + +(defun regenerate-all () + (let ((all (miniblog.content:gen-all (miniblog.db:get-entries) + (miniblog.db:get-pages) + :generator *generator* + :page-generator *page-generator* + :rss-generator *rss-generator* + :tz *blog-timezone*))) (mapcar #'regenerate-file all))) (defun entries-in-month (year month) @@ -147,30 +227,61 @@ "Determine if there is only one entry in a given month and year" (eql (entries-in-month year month) 1)) -(defun add-new (regen) - (let ((text (miniblog.edit:edit-text))) - (if text - (let* ((post (miniblog.edit:get-title-and-content text)) - (title (nth 0 post)) - (content (nth 1 post)) - (new-entry (miniblog.db:add-entry - (or title "Untitled") - content - :username (get-username))) - (year-month (miniblog.content:year-month-of-entry - new-entry :tz *blog-timezone*)) - (year (car year-month)) - (month (cdr year-month)) - (entries (miniblog.db:get-entries))) - (if (or regen (new-month-p year month)) - (regenerate-all entries) - (regenerate-index-and-given-month entries year month))) - (format t "Abandoning post...~%")))) +(defgeneric add-entry (entry-type uri regen) + (:documentation "Add a new entry of type ENTRY-TYPE. URI specifies the logical location of the new entry which is only valid for certain entry types.")) + +(defmethod add-entry ((entry-type (eql :post)) uri regen) + (declare (ignore uri)) + (if-let ((text (miniblog.edit:edit-text))) + (let* ((post (miniblog.edit:get-title-and-content text)) + (title (nth 0 post)) + (content (nth 1 post)) + (new-entry (miniblog.db:add-entry + (or title "Untitled") + content + :username (get-username))) + (year-month (miniblog.content:year-month-of-entry + new-entry :tz *blog-timezone*)) + (year (car year-month)) + (month (cdr year-month))) + (if (or regen (new-month-p year month)) + (regenerate-all) + (regenerate-index-and-given-month (miniblog.db:get-entries) year month))) + (format t "Abandoning post...~%"))) + +(defmethod add-entry ((entry-type (eql :page)) uri regen) + (or (when-let* ((uri-components (str:split "/" uri)) + (name (car (last uri-components))) + (parent-path (butlast uri-components)) + (parent-id (miniblog.content:get-page-id-by-path + parent-path + (miniblog.db:get-pages)))) + (if-let ((text (miniblog.edit:edit-text))) + (let* ((post (miniblog.edit:get-title-and-content text)) + (title (nth 0 post)) + (content (nth 1 post)) + (new-entry (miniblog.db:add-page + name + (or title "Untitled") + content + :parent parent-id + :username (get-username)))) + (if (or regen (= (length uri-components) 1)) + (regenerate-all) + (regenerate-page-and-parent-and-children parent-path + (getf new-entry :id) + (miniblog.db:get-pages)))) + (format t "Abandoning page...~%")) + t) + (format t "Invalid page name ~a~%" uri))) (defun date-format (datetime) (funcall (miniblog.format:make-long-date-formatter *blog-timezone*) datetime)) -(defun get-post (id) +(defgeneric get-entry (entry-type id) + (:documentation "Get an entry of type ENTRY-TYPE with id ID")) + +(defmethod get-entry ((entry-type (eql :post)) id) (miniblog.db:with-entry-id entry id (format t "ID: ~d~%" (getf entry :id)) (format t "Created: ~A by ~A~%" @@ -180,6 +291,19 @@ (format t "Title: ~A~%" (getf entry :title)) (format t "Content:~%~A~%" (getf entry :content)))) +(defmethod get-entry ((entry-type (eql :page)) id) + (miniblog.db:with-page-id page id + (format t "ID: ~d~%" (getf page :id)) + (format t "Path: page/~a~%" (str:join "/" (miniblog.content:get-path-to-page + id + (cadr (multiple-value-list (miniblog.db:get-pages)))))) + (format t "Created: ~A by ~A~%" + (date-format (getf page :created-at)) (getf page :created-by)) + (format t "Last updated: ~A by ~A~%" + (date-format (getf page :last-updated-at)) (getf page :last-updated-by)) + (format t "Title: ~A~%" (getf page :title)) + (format t "Content:~%~A~%" (getf page :content)))) + (defun make-template (title content) (with-output-to-string (out) (princ (or title "Untitled post") out) @@ -187,33 +311,59 @@ (terpri out) (princ content out))) -(defun edit-post (id regen) +(defgeneric edit-entry (entry-type id regen) + (:documentation "Edit an entry of type ENTRY-TYPE with id ID")) + +(defmethod edit-entry ((entry-type (eql :post)) id regen) (miniblog.db:with-entry-id entry id - (let ((text (miniblog.edit:edit-text - :template (make-template (getf entry :title) (getf entry :content))))) - (if text - (let* ((post (miniblog.edit:get-title-and-content text)) - (title (nth 0 post)) - (content (nth 1 post))) - (miniblog.db:update-entry - id title content - :username (get-username)) - (let* ((created-at (getf entry :created-at)) - (year (timestamp-year created-at - :timezone *blog-timezone*)) - (month (timestamp-month created-at - :timezone *blog-timezone*)) - (entries (miniblog.db:get-entries))) - (if (not regen) - (regenerate-index-and-given-month entries year month) - (regenerate-all entries)))) - (format t "No change, abandoning...~%"))))) + (if-let ((text (miniblog.edit:edit-text + :template (make-template (getf entry :title) (getf entry :content))))) + (let* ((post (miniblog.edit:get-title-and-content text)) + (title (nth 0 post)) + (content (nth 1 post))) + (miniblog.db:update-entry + id title content + :username (get-username)) + (let* ((created-at (getf entry :created-at)) + (year (timestamp-year created-at + :timezone *blog-timezone*)) + (month (timestamp-month created-at + :timezone *blog-timezone*))) + (if (not regen) + (regenerate-index-and-given-month (miniblog.db:get-entries) year month) + (regenerate-all)))) + (format t "No change, abandoning...~%")))) + +(defmethod edit-entry ((entry-type (eql :page)) id regen) + (miniblog.db:with-page-id entry id + (if-let ((text (miniblog.edit:edit-text + :template (make-template (getf entry :title) (getf entry :content))))) + (let* ((page (miniblog.edit:get-title-and-content text)) + (title (nth 0 page)) + (content (nth 1 page)) + (new-entry (miniblog.db:update-page + id (getf entry :name) title content + :username (get-username)))) + (if (not regen) + (let* ((pages-tuple (multiple-value-list (miniblog.db:get-pages))) + (page-table (cadr pages-tuple)) + (parent-id (getf new-entry :parent)) + (root (gethash 0 page-table)) + (path (miniblog.content:get-path-to-page parent-id page-table))) + (regenerate-page-and-parent-and-children path id root)) + (regenerate-all))) + (format t "No change, abandoning...~%")))) + (defun removed-month-p (year month) "Determine if there are 0 entries in the given month and year" (eql (entries-in-month year month) 0)) -(defun delete-post (id regen) +(defgeneric delete-entry (entry-type id children-to-root regen) + (:documentation "Delete entry of type ENTRY-TYPE with id ID. CHILDREN-TO-ROOT specifies how child entries will be rerooted; only applies to hierarchical entry types.")) + +(defmethod delete-entry ((entry-type (eql :post)) id children-to-root regen) + (declare (ignore children-to-root)) (miniblog.db:with-entry-id entry id (format t "Deleting post ID ~d...~%" id) (miniblog.db:delete-entry id) @@ -221,20 +371,87 @@ (year (timestamp-year created-at :timezone *blog-timezone*)) (month (timestamp-month created-at - :timezone *blog-timezone*)) - (entries (miniblog.db:get-entries))) + :timezone *blog-timezone*))) + (flush-monthly-path year month) (if (or regen (removed-month-p year month)) - (regenerate-all entries) - (regenerate-index-and-given-month entries year month))))) + (regenerate-all) + (regenerate-index-and-given-month (miniblog.db:get-entries) year month))))) + +(defmethod delete-entry ((entry-type (eql :page)) id children-to-root regen) + (miniblog.db:with-page-id page id + (format t "Delete page ID ~d...~%" id) + (let* ((pages-tuple (multiple-value-list (miniblog.db:get-pages))) + (page-table (cadr pages-tuple)) + (path (miniblog.content:get-path-to-page id page-table))) + (miniblog.db:delete-page id :children (if children-to-root + :children-to-root + :children-to-parent)) + (flush-page-path path) + (if (or children-to-root (< (length path) 3)) + (regenerate-all) + (let* ((parent-id (getf page :parent)) + (pages-tuple (multiple-value-list (miniblog.db:get-pages))) + (page-table (cadr pages-tuple)) + (parent (gethash parent-id page-table)) + (parent-of-parent-id (getf parent :parent)) + (root (gethash 0 page-table)) + (path (miniblog.content:get-path-to-page parent-of-parent-id page-table))) + (regenerate-page-and-parent-and-children path parent-id root)))))) + +(defgeneric move-entry (entry-type id uri regen) + (:documentation "Move entry ID of type ENTRY-TYPE to location specified in URI. Only applies to hierarchical entry types.")) + +(defmethod move-entry ((entry-type (eql :post)) id uri regen) + (declare (ignore id uri regen)) + (format t "Posts can't be moved!~%")) -(defun list-posts (start n) +(defmethod move-entry ((entry-type (eql :page)) id uri regen) + (declare (ignore regen)) + (or (when-let* ((uri-components (str:split "/" uri)) + (name (car (last uri-components))) + (parent-path (butlast uri-components)) + (parent-id (miniblog.content:get-page-id-by-path + parent-path + (miniblog.db:get-pages)))) + + (miniblog.db:move-page id parent-id) + ;; FIXME: Regeneration logic for moving pages is complex so + ;; we're punting for now but we should avoid doing a full + ;; regen unless we have to. The basic logic should look + ;; something like: + ;; IF regen is true OR old path is top-level OR new path top-level + ;; THEN + ;; regenerate-all + ;; ELSE + ;; regenerate old parent tree + ;; regenerate new parent tree + (regenerate-all) + t) + (format t "Invalid path ~a~%" uri))) + +(defgeneric list-entries (entry-type start n) + (:documentation "List entries of type ENTRY-TYPE, possibly restricted to entries START through N. For hierarchical entry types, only START is consumed, specifying which entry to start listing from in the tree.")) + +(defmethod list-entries ((entry-type (eql :post)) start n) (let* ((entries (miniblog.db:get-entries)) (first (or start 0)) (last (if n (+ first n) (length entries)))) (dolist (entry (subseq entries first last)) - (format t "~d \"~A\" ~A~%" (getf entry :id) (getf entry :title) (getf entry :created-by))))) + (format t "~d \"~a\" ~a~%" (getf entry :id) (getf entry :title) (getf entry :created-by))))) + +(defmethod list-entries ((entry-type (eql :post)) start n) + (declare (ignore n)) + (labels ((traverse (node depth) + (destructuring-bind (&key id name title children created-by &allow-other-keys) + node + (if (not (or (null id) (= id 0))) + (format t "~v{~a~:*~}~a (ID ~d) - \"~a\" ~a~%" depth '(" ") name id title created-by)) + (loop for entry in children + do (traverse entry (1+ depth)))))) + (let ((pages (miniblog.db:get-pages start))) + (traverse pages 0)))) (defun init-tz () (reread-timezone-repository)) @@ -265,13 +482,16 @@ (set-config-and-defaults) (make-generators)) -(defun miniblog (&key add get edit delete list start n regen-all help) +(defun miniblog (&key add get edit delete list start n page move uri children-to-root regen-all help) + (declare (ignore help)) (initialize) (miniblog.db:init :sqlite3 :database-name (get-db-filename)) - (cond (add (add-new regen-all)) - (get (get-post get)) - (edit (edit-post edit regen-all)) - (delete (delete-post delete regen-all)) - (list (list-posts start n)) - (regen-all (regenerate-all (miniblog.db:get-entries))) - (t (show-option-help +command-line-spec+)))) + (let ((entry-type (if page :page :post))) + (cond (add (add-entry entry-type uri regen-all)) + (get (get-entry entry-type get)) + (edit (edit-entry entry-type edit regen-all)) + (delete (delete-entry entry-type delete children-to-root regen-all)) + (list (list-entries entry-type start n)) + (move (move-entry entry-type move uri regen-all)) + (regen-all (regenerate-all)) + (t (show-option-help +command-line-spec+))))) diff --git a/src/packages.lisp b/src/packages.lisp @@ -16,23 +16,26 @@ (:export #:init #:init-tables #:add-entry #:get-entry #:with-entry-id #:get-entries #:update-entry #:delete-entry - #:add-page #:get-page #:get-pages #:update-page - #:delete-page)) + #:add-page #:get-page #:with-page-id + #:get-pages #:update-page #:delete-page + #:move-page)) (defpackage :miniblog.content (:use :cl :local-time :cl-emb :str) - (:export #:make-generator #:make-rss-generator - #:get-archive-date-list + (:export #:make-generator #:make-page-generator + #:make-rss-generator #:get-archive-date-list + #:get-page-id-by-path #:get-page-by-path #:get-path-to-page #:year-month-of-entry #:year-month-of-latest-entry - #:gen-all #:gen-index #:gen-month #:gen-rss-feed - #:gen-post)) + #:gen-all #:gen-all-pages #:gen-index #:gen-month + #:gen-rss-feed #:gen-page #:gen-post)) (defpackage :miniblog (:use :cl :command-line-arguments :local-time) + (:import-from :alexandria :if-let :when-let*) (:export #:initialize #:entry-point *blog-title* *blog-header* *blog-links* *blog-stylesheet* *blog-timezone* *public-html* *root-uri* - *generator* *rss-generator* + *generator* *page-generator* *rss-generator* *blog-description* *blog-link* *blog-image-url* *blog-language* *blog-category* *blog-copyright* *blog-managing-editor* *blog-webmaster*)) diff --git a/src/pagetemplate.lhtml b/src/pagetemplate.lhtml @@ -1,105 +0,0 @@ -<!DOCTYPE html> -<html> - <head> - <title> - <%= (or (getf env :title) "Miniblog") %> - <% @if post/title %> - - <% @var post/title %> - <% @endif %> - </title> - <style> - header#miniblog-header { width: 100%; } - section#miniblog-left { float: left; width: 15%; } - section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; } - nav#miniblog-nav { float: left; width: 20%; } - div#miniblog-rss { clear: both; } - table.calendar { padding: 10px; float: left; } - table.calendar td { width: 25%; } - @media screen and (max-aspect-ratio: 1/1) { - section#miniblog-left { float: none; width: 100%; } - section#miniblog-main { float: none; width: 100%; } - nav#miniblog-nav { float: none; width: 100%; } - } - </style> - <% @if stylesheet %> - <link rel="stylesheet" type="text/css" href="<% @var stylesheet %>"> - <% @endif %> - <% @if enable-rss %> - <link rel="alternate" type="application/rss+xml" - title="RSS feed for <%= (or (getf env :title) "Miniblog") %>" - href="<% @var root-uri %>rss.xml"> - <% @endif %> - </head> - <body> - <header id="miniblog-header"> - <% @if header %> - <% @includevar header %> - <% @endif %> - </header> - <section id="miniblog-left"> - <% @if links %> - <% @loop links %> - <a href="<% @var link %>"><% @var text %></a><br> - <% @endloop %> - <% @endif %> - </section> - <section id="miniblog-main"> - <% @if post/content %> - <% (destructuring-bind (&key ((:post (&key content created-at last-updated-at last-updated-by &allow-other-keys))) content-formatter long-date-formatter &allow-other-keys) env %> - <h2><% @var post/title %></h2> - <article> - <%= (funcall content-formatter content) %> - </article> - <p> - <small> - Posted by <% @var post/created-by %> on - <%= (funcall long-date-formatter created-at) %> - <% (if (local-time:timestamp/= created-at last-updated-at) - (format t "<br>~%Last updated by ~A on ~A~%" - last-updated-by - (funcall long-date-formatter last-updated-at))) %> - </small> - </p> - <% ) %> - <% @else %> - No page found. - <% @endif %> - </section> - <nav id="miniblog-nav"> - <% @if archive-date-list %> - <% - (let ((arc (copy-list (getf env :archive-date-list)))) - (loop while arc do - (format t "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc)) - (let ((month-entries '()) - (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) - (loop for cal-month downfrom 12 to 1 do - (if (and arc (= cal-month (cdar arc))) - (progn - (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries) - (pop arc)) - (push nil month-entries))) - (loop for row from 0 to 2 do - (format t "<tr>~%") - (loop for cal-month from (* row 4) to (+ (* row 4) 3) do - (format t "<td>") - (if (nth cal-month month-entries) - (format t "<a href=\"~a~a\">~a</a>" - (or (getf env :root-uri) "") - (nth cal-month month-entries) - (nth cal-month month-names)) - (format t "~A" (nth cal-month month-names))) - (format t "</td>~%")) - (format t "</tr>~%"))) - (format t "</table>~%"))) %> - <% @endif %> - <% @if enable-rss %> - <div id="miniblog-rss"> - <a href="<% @var root-uri %>rss.xml" target="_blank"> - Subscribe to <%= (or (getf env :title) "Miniblog") %> - </a> - </div> - <% @endif %> - </nav> - </body> -</html> diff --git a/src/template.lhtml b/src/template.lhtml @@ -1,119 +0,0 @@ -<!DOCTYPE html> -<html> - <head> - <title> - <%= (or (getf env :title) "Miniblog") %> - <% @if year %> - - <% @var year %>/<% @var month %> - <% @endif %> - </title> - <style> - header#miniblog-header { width: 100%; } - section#miniblog-left { float: left; width: 15%; } - section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; } - nav#miniblog-nav { float: left; width: 20%; } - div#miniblog-rss { clear: both; } - table.calendar { padding: 10px; float: left; } - table.calendar td { width: 25%; } - @media screen and (max-aspect-ratio: 1/1) { - section#miniblog-left { float: none; width: 100%; } - section#miniblog-main { float: none; width: 100%; } - nav#miniblog-nav { float: none; width: 100%; } - } - </style> - <% @if stylesheet %> - <link rel="stylesheet" type="text/css" href="<% @var stylesheet %>"> - <% @endif %> - <% @if enable-rss %> - <link rel="alternate" type="application/rss+xml" - title="RSS feed for <%= (or (getf env :title) "Miniblog") %>" - href="<% @var root-uri %>rss.xml"> - <% @endif %> - </head> - <body> - <header id="miniblog-header"> - <% @if header %> - <% @includevar header %> - <% @endif %> - </header> - <section id="miniblog-left"> - <% @if links %> - <% @loop links %> - <a href="<% @var link %>"><% @var text %></a><br> - <% @endloop %> - <% @endif %> - </section> - <section id="miniblog-main"> - <% @if posts %> - <% (let ((short-date) (render-hr nil)) %> - <% (loop for post in (getf env :posts) do %> - <% (destructuring-bind (&key id created-at last-updated-at title content created-by last-updated-by) post %> - <% (let ((curr-short-date (funcall (getf env :short-date-formatter) created-at))) %> - <% (if render-hr %> - <hr> - <% ) %> - <% (setf render-hr t) %> - <% (if (string/= short-date curr-short-date) - (progn - (setf short-date curr-short-date) - (format t "<h1>~A</h1>~%" short-date)))) %> - <a name="<%= id %>"></a> - <h2><%= title %></h2> - <article> - <%= (funcall (getf env :content-formatter) content) %> - </article> - <p> - <small> - Posted by <%= created-by %> on - <%= (funcall (getf env :long-date-formatter) created-at) %> - <% (if (local-time:timestamp/= created-at last-updated-at) - (format t "<br>~%Last updated by ~A on ~A~%" - last-updated-by - (funcall (getf env :long-date-formatter) last-updated-at))) %> - </small> - </p> - <% ) %> - <% ) %> - <% ) %> - <% @else %> - No posts found. - <% @endif %> - </section> - <nav id="miniblog-nav"> - <% @if archive-date-list %> - <% - (let ((arc (copy-list (getf env :archive-date-list)))) - (loop while arc do - (format t "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc)) - (let ((month-entries '()) - (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) - (loop for cal-month downfrom 12 to 1 do - (if (and arc (= cal-month (cdar arc))) - (progn - (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries) - (pop arc)) - (push nil month-entries))) - (loop for row from 0 to 2 do - (format t "<tr>~%") - (loop for cal-month from (* row 4) to (+ (* row 4) 3) do - (format t "<td>") - (if (nth cal-month month-entries) - (format t "<a href=\"~a~a\">~a</a>" - (or (getf env :root-uri) "") - (nth cal-month month-entries) - (nth cal-month month-names)) - (format t "~A" (nth cal-month month-names))) - (format t "</td>~%")) - (format t "</tr>~%"))) - (format t "</table>~%"))) %> - <% @endif %> - <% @if enable-rss %> - <div id="miniblog-rss"> - <a href="<% @var root-uri %>rss.xml" target="_blank"> - Subscribe to <%= (or (getf env :title) "Miniblog") %> - </a> - </div> - <% @endif %> - </nav> - </body> -</html> diff --git a/templates/header.lhtml b/templates/header.lhtml @@ -0,0 +1,5 @@ +<header id="miniblog-header"> + <% @if header %> + <% @includevar header %> + <% @endif %> +</header> diff --git a/templates/html-head.lhtml b/templates/html-head.lhtml @@ -0,0 +1,31 @@ +<head> + <title> + <%= (or (getf env :title) "Miniblog") %> + <% @if year %> + - <% @var year %>/<% @var month %> + <% @endif %> + </title> + <style> + header#miniblog-header { width: 100%; } + section#miniblog-left { float: left; width: 15%; } + section#miniblog-main { float: left; width: <%= (if (getf env :links) "65%" "80%") %>; } + nav#miniblog-nav { float: left; width: 20%; } + div#miniblog-rss { clear: both; } + table.calendar { padding: 10px; float: left; } + table.calendar td { width: 25%; } + ul.page-list { list-style: none; margin: 0; padding: 0 0 0 10px; } + @media screen and (max-aspect-ratio: 1/1) { + section#miniblog-left { float: none; width: 100%; } + section#miniblog-main { float: none; width: 100%; } + nav#miniblog-nav { float: none; width: 100%; } + } + </style> + <% @if stylesheet %> + <link rel="stylesheet" type="text/css" href="<% @var stylesheet %>"> + <% @endif %> + <% @if enable-rss %> + <link rel="alternate" type="application/rss+xml" + title="RSS feed for <%= (or (getf env :title) "Miniblog") %>" + href="<% @var root-uri %>rss.xml"> + <% @endif %> +</head> diff --git a/templates/left-column.lhtml b/templates/left-column.lhtml @@ -0,0 +1,24 @@ +<section id="miniblog-left"> + <a href="/">Home</a><br> + <% @if pages %><% + (labels ((descend (parent-path child-path pages) + (format t "<ul class=\"page-list\">~%") + (loop for page in (getf pages :children) + do (let* ((next-name (car child-path)) + (descendents (cdr child-path)) + (page-name (getf page :name)) + (page-path (append parent-path (list page-name))) + (page-path-str (str:join "/" page-path))) + (format t "<li><a href=\"~apage/~a\">~a</a></li>~%" (getf env :root-uri) page-path-str (getf page :title)) + (if (string= page-name next-name) + (descend page-path descendents page)))) + (format t "</ul>~%"))) + (descend nil (getf env :path) (getf env :pages))) + %><% @endif %> + <br> + <% @if links %> + <% @loop links %> + <a href="<% @var link %>"><% @var text %></a><br> + <% @endloop %> + <% @endif %> +</section> diff --git a/templates/nav.lhtml b/templates/nav.lhtml @@ -0,0 +1,36 @@ +<nav id="miniblog-nav"> + <% @if archive-date-list %> + <% + (let ((arc (copy-list (getf env :archive-date-list)))) + (loop while arc do + (format t "<table class=\"calendar\"><tr><th colspan=\"4\">~a</th></tr>~%" (caar arc)) + (let ((month-entries '()) + (month-names '("Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"))) + (loop for cal-month downfrom 12 to 1 do + (if (and arc (= cal-month (cdar arc))) + (progn + (push (format nil "~d/~2,'0d/index.html" (caar arc) (cdar arc)) month-entries) + (pop arc)) + (push nil month-entries))) + (loop for row from 0 to 2 do + (format t "<tr>~%") + (loop for cal-month from (* row 4) to (+ (* row 4) 3) do + (format t "<td>") + (if (nth cal-month month-entries) + (format t "<a href=\"~a~a\">~a</a>" + (or (getf env :root-uri) "") + (nth cal-month month-entries) + (nth cal-month month-names)) + (format t "~A" (nth cal-month month-names))) + (format t "</td>~%")) + (format t "</tr>~%"))) + (format t "</table>~%"))) %> + <% @endif %> + <% @if enable-rss %> + <div id="miniblog-rss"> + <a href="<% @var root-uri %>rss.xml" target="_blank"> + Subscribe to <%= (or (getf env :title) "Miniblog") %> + </a> + </div> + <% @endif %> +</nav> diff --git a/templates/pagetemplate.lhtml b/templates/pagetemplate.lhtml @@ -0,0 +1,31 @@ +<!DOCTYPE html> +<html> + <% @include html-head.lhtml %> + <body> + <% @include header.lhtml %> + <% @include left-column.lhtml %> + <section id="miniblog-main"> + <% @if post/content %> + <% (destructuring-bind (&key ((:post (&key content created-at last-updated-at last-updated-by &allow-other-keys))) content-formatter long-date-formatter &allow-other-keys) env %> + <h2><% @var post/title %></h2> + <article> + <%= (funcall content-formatter content) %> + </article> + <p> + <small> + Posted by <% @var post/created-by %> on + <%= (funcall long-date-formatter created-at) %> + <% (if (local-time:timestamp/= created-at last-updated-at) + (format t "<br>~%Last updated by ~A on ~A~%" + last-updated-by + (funcall long-date-formatter last-updated-at))) %> + </small> + </p> + <% ) %> + <% @else %> + No page found. + <% @endif %> + </section> + <% @include nav.lhtml %> + </body> +</html> diff --git a/src/rss.lxml b/templates/rss.lxml diff --git a/templates/template.lhtml b/templates/template.lhtml @@ -0,0 +1,45 @@ +<!DOCTYPE html> +<html> + <% @include html-head.lhtml %> + <body> + <% @include header.lhtml %> + <% @include left-column.lhtml %> + <section id="miniblog-main"> + <% @if posts %> + <% (let ((short-date) (render-hr nil)) %> + <% (loop for post in (getf env :posts) do %> + <% (destructuring-bind (&key id created-at last-updated-at title content created-by last-updated-by) post %> + <% (let ((curr-short-date (funcall (getf env :short-date-formatter) created-at))) %> + <% (if render-hr %> + <hr> + <% ) %> + <% (setf render-hr t) %> + <% (if (string/= short-date curr-short-date) + (progn + (setf short-date curr-short-date) + (format t "<h1>~A</h1>~%" short-date)))) %> + <a name="<%= id %>"></a> + <h2><%= title %></h2> + <article> + <%= (funcall (getf env :content-formatter) content) %> + </article> + <p> + <small> + Posted by <%= created-by %> on + <%= (funcall (getf env :long-date-formatter) created-at) %> + <% (if (local-time:timestamp/= created-at last-updated-at) + (format t "<br>~%Last updated by ~A on ~A~%" + last-updated-by + (funcall (getf env :long-date-formatter) last-updated-at))) %> + </small> + </p> + <% ) %> + <% ) %> + <% ) %> + <% @else %> + No posts found. + <% @endif %> + </section> + <% @include nav.lhtml %> + </body> +</html>