commit 83660baa6068c8bae988a2615d47f43458508c45
parent 4325b31043605dbd23caf80dfc3f028d6ae8de73
Author: Decay <decaydjk@tilde.town>
Date: Tue, 4 Feb 2020 23:13:49 +0000
Basic implementation of command-line interface and editing.
No file generation yet.
Diffstat:
6 files changed, 130 insertions(+), 8 deletions(-)
diff --git a/miniblog.asd b/miniblog.asd
@@ -9,10 +9,12 @@
"dbd-sqlite3"
"sxql"
"mito"
- "local-time")
+ "local-time"
+ "str"
+ "command-line-arguments")
:defsystem-depends-on (:eco)
:pathname "src/"
- :entry-point "miniblog:main"
+ :entry-point "miniblog:entry-point"
:components ((:file "packages")
(:file "format")
(:file "edit")
diff --git a/src/db.lisp b/src/db.lisp
@@ -44,6 +44,15 @@
(if entry
(xform entry))))
+(defmacro with-entry-id (entry id &rest body)
+ "Takes a varname to hold the entry list and a post id
+ and executes the forms in body with the entry bound
+ to the specified entry variable"
+ `(let ((,entry (miniblog.db:get-entry ,id)))
+ (if ,entry
+ (progn ,@body)
+ (format t "Post ID ~d not found~%" ,id))))
+
(defun get-entries (&key year month max-entries)
"Get entries from the database, optionally limited to a date
range or count"
diff --git a/src/edit.lisp b/src/edit.lisp
@@ -43,3 +43,16 @@ Text goes here"
contents))))
(if (not (string= input-content edited-content))
edited-content))))
+
+(defun get-title-and-content (text)
+ "Extract the title and content from a post. Assumption is that if the
+ text has a first line, then a bare second line, then more content,
+ the first line is the title (git-ish semantics) otherwise the entire
+ content is the body and the title is empty"
+ (let* ((lines (lines text))
+ (first-line (trim (nth 0 lines)))
+ (second-line (trim (nth 1 lines)))
+ (rest (nthcdr 2 lines)))
+ (if (and first-line rest (string= second-line ""))
+ (list (car lines) (unlines rest))
+ (list () text))))
diff --git a/src/miniblog.lisp b/src/miniblog.lisp
@@ -1,3 +1,99 @@
(in-package :miniblog)
-(defun main ())
+(defparameter +command-line-spec+
+ '((("add" #\a) :type boolean :optional t :documentation "Add new post")
+ (("edit" #\e) :type integer :optional t :documentation "Edit a post by ID")
+ (("get" #\g) :type integer :optional t :documentation "Get a post by ID")
+ (("list" #\l) :type boolean :optional t :documentation "List posts")
+ (("start" #\s) :type integer :optional t
+ :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)")
+ (("regen-all" #\r) :type boolean :optional t
+ :documentation "When adding or editing, regenerate all pages instead of just those miniblog thinks have changed")
+ (("help" #\h) :type boolean :optional t :documentation "This help information")))
+
+(defun main (args)
+ (handle-command-line
+ +command-line-spec+
+ 'miniblog
+ :command-line args
+ :name "miniblog"))
+
+(defun entry-point ()
+ (main *command-line-arguments*))
+
+(defun get-username ()
+ (uiop:getenv "USER"))
+
+(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)))
+ (miniblog.db:add-entry
+ (or title "Untitled")
+ content
+ :username (get-username)))
+ (format t "Abandoning post...~%"))))
+
+(defun date-format (datetime)
+ (funcall (miniblog.format:make-long-date-formatter *pst*) datetime))
+
+(defun get-post (id)
+ (miniblog.db:with-entry-id entry id
+ (format t "ID: ~d~%" (nth 0 entry))
+ (format t "Created: ~A by ~A~%"
+ (date-format (nth 1 entry)) (nth 5 entry))
+ (format t "Last updated: ~A by ~A~%"
+ (date-format (nth 2 entry)) (nth 6 entry))
+ (format t "Title: ~A~%" (nth 3 entry))
+ (format t "Content:~%~A~%" (nth 4 entry))))
+
+(defun make-template (title content)
+ (with-output-to-string (out)
+ (princ (or title "Untitled post") out)
+ (terpri out)
+ (terpri out)
+ (princ content out)))
+
+(defun edit-post (id regen)
+ (miniblog.db:with-entry-id entry id
+ (let ((text (miniblog.edit:edit-text
+ :template (make-template (nth 3 entry) (nth 4 entry)))))
+ (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)))
+ (format t "No change, abandoning...~%")))))
+
+(defun list-posts (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~%" (first entry) (nth 3 entry) (nth 5 entry)))))
+
+(defun init-tz ()
+ (reread-timezone-repository)
+ (defvar *pst* (find-timezone-by-location-name "US/Pacific")))
+
+(defun get-db-filename ()
+ (namestring (merge-pathnames
+ (user-homedir-pathname)
+ (make-pathname :name ".miniblog" :type "db"))))
+
+(defun miniblog (&key add get edit list start n regen-all help)
+ (init-tz)
+ (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))
+ (list (list-posts start n))
+ (t (show-option-help +command-line-spec+))))
diff --git a/src/packages.lisp b/src/packages.lisp
@@ -7,13 +7,14 @@
#:make-long-date-formatter))
(defpackage :miniblog.edit
- (:use :cl :uiop/os :uiop/run-program :cl-fad)
- (:export #:edit-text))
+ (:use :cl :uiop/os :uiop/run-program :cl-fad :str)
+ (:export #:edit-text #:get-title-and-content))
(defpackage :miniblog.db
(:use :cl :mito :sxql)
- (:export #:init #:add-entry #:get-entry #:get-entries #:update-entry))
+ (:export #:init #:add-entry #:get-entry #:with-entry-id
+ #:get-entries #:update-entry))
(defpackage :miniblog
- (:use :cl)
- (:export #:main))
+ (:use :cl :command-line-arguments :local-time)
+ (:export #:entry-point))
diff --git a/src/template.eco b/src/template.eco
@@ -5,6 +5,7 @@
<title><%= (or title "Miniblog") %></title>
</head>
<body>
+ <!-- <%= year %><%= month %><%= start-entry %><%= max-entries %> -->
<% if posts %>
<% let ((short-date)) %>
<% loop for (id created-at updated-at title content username last-updated-by) in posts do %>
