550 lines
24 KiB
EmacsLisp
550 lines
24 KiB
EmacsLisp
;;; spine.el — personal reading tracker, served from Emacs
|
|
|
|
;; --- package bootstrap ------------------------------------------------
|
|
|
|
(require 'package)
|
|
(add-to-list 'package-archives
|
|
'("melpa" . "https://melpa.org/packages/")
|
|
t)
|
|
(package-initialize)
|
|
|
|
(dolist (pkg '(simple-httpd mustache ht))
|
|
(unless (package-installed-p pkg)
|
|
(package-refresh-contents)
|
|
(package-install pkg)))
|
|
|
|
(require 'simple-httpd)
|
|
(require 'mustache)
|
|
(require 'ht)
|
|
(require 'cl-lib)
|
|
|
|
;; --- configuration ----------------------------------------------------
|
|
|
|
(defvar spine-port 8080
|
|
"Port for the Spine HTTP server.")
|
|
(defvar spine-host nil
|
|
"Host for the Spine HTTP server.
|
|
nil means localhost only. Set to a string like \"0.0.0.0\" to listen on
|
|
all interfaces.")
|
|
|
|
(defvar spine-org-file "~/spine/books.org"
|
|
"Path to the spine.org data file.")
|
|
|
|
(defvar spine-template-dir
|
|
(expand-file-name "templates/"
|
|
(file-name-directory load-file-name))
|
|
"Directory containing .mustache templates.")
|
|
|
|
;; --- template rendering -----------------------------------------------
|
|
|
|
(defun spine-render (name context)
|
|
"Render templates/NAME.mustache with CONTEXT (an ht hash table).
|
|
Returns the rendered string."
|
|
(mustache-render
|
|
(with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name name spine-template-dir))
|
|
(buffer-string))
|
|
context))
|
|
|
|
(defun spine--h (text)
|
|
"HTML-escape TEXT."
|
|
(when text
|
|
(let ((s text))
|
|
(setq s (replace-regexp-in-string "&" "&" s))
|
|
(setq s (replace-regexp-in-string "<" "<" s))
|
|
(setq s (replace-regexp-in-string ">" ">" s))
|
|
(setq s (replace-regexp-in-string "\"" """ s))
|
|
s)))
|
|
|
|
|
|
(defun spine-add-form-model (books)
|
|
"Build the view model ht for templates/add.mustache from BOOKS."
|
|
(let ((authors nil)
|
|
(categories nil))
|
|
(dolist (book books)
|
|
(let ((author (plist-get book :author)))
|
|
(when (and author (> (length author) 0)
|
|
(not (member author authors)))
|
|
(push author authors)))
|
|
(dolist (tag (or (plist-get book :tags) nil))
|
|
(unless (member tag categories)
|
|
(push tag categories))))
|
|
(ht ("app_title" "spine")
|
|
("existing_authors" (sort authors #'string<))
|
|
("existing_categories" (sort categories #'string<)))))
|
|
|
|
(defun spine-index-model (books &optional filter selected-id)
|
|
"Build the view model ht for templates/index.mustache from BOOKS.
|
|
FILTER controls which books are shown:
|
|
nil - concise: READING + 5 most recent WANT, others as summary links
|
|
all - full listing, no truncation
|
|
read - only READ books
|
|
want - only WANT books
|
|
SELECTED-ID expands the matching book's detail section."
|
|
(let* ((status-labels
|
|
'(("WANT" . "on deck")
|
|
("READING" . "reading")
|
|
("READ" . "read")
|
|
("ABANDONED" . "abandoned")))
|
|
(format-icons
|
|
'(("hardcover" . "ti-book")
|
|
("ebook" . "ti-device-tablet")
|
|
("audiobook" . "ti-headphones")))
|
|
(order '("WANT" "READING" "READ" "ABANDONED"))
|
|
(valid-filters '("all" "read" "want"))
|
|
(effective-filter (if (member filter valid-filters) filter nil))
|
|
(grouped (make-hash-table :test 'equal))
|
|
(total (length books))
|
|
(reading-count 0))
|
|
(dolist (book books)
|
|
(when (equal "READING" (plist-get book :status))
|
|
(cl-incf reading-count)))
|
|
(dolist (book books)
|
|
(let ((status (or (plist-get book :status) "WANT")))
|
|
(push book (gethash status grouped))))
|
|
(let ((groups nil)
|
|
(summary-groups nil))
|
|
(dolist (status order)
|
|
(let ((group-books (nreverse (gethash status grouped))))
|
|
(when group-books
|
|
(if (and (null effective-filter)
|
|
(member status '("READ" "ABANDONED")))
|
|
(push (ht ("label" (cdr (assoc status status-labels)))
|
|
("count" (length group-books))
|
|
("href" (format "/index?filter=%s"
|
|
(downcase status))))
|
|
summary-groups)
|
|
(when (or (null effective-filter)
|
|
(string= (downcase status) effective-filter)
|
|
(string= effective-filter "all"))
|
|
(when (and (null effective-filter)
|
|
(string= status "WANT"))
|
|
(setq group-books
|
|
(cl-subseq (sort group-books
|
|
(lambda (a b)
|
|
(let ((a-date (plist-get a :added))
|
|
(b-date (plist-get b :added)))
|
|
(cond
|
|
((null a-date) nil)
|
|
((null b-date) t)
|
|
(t (string> a-date b-date))))))
|
|
0 (min (length group-books) 5))))
|
|
(let ((book-models nil))
|
|
(dolist (book group-books)
|
|
(let* ((id (plist-get book :id))
|
|
(selected (equal id selected-id))
|
|
(fmt (plist-get book :format))
|
|
(rating (plist-get book :rating))
|
|
(notes (plist-get book :notes))
|
|
(status (or (plist-get book :status) "WANT"))
|
|
(model
|
|
(ht
|
|
("format_icon"
|
|
(or (cdr (assoc fmt format-icons)) ""))
|
|
("status_class" (downcase status))
|
|
("status_label" (downcase status))
|
|
("title" (plist-get book :title))
|
|
("author" (or (plist-get book :author) ""))
|
|
("tags_inline"
|
|
(let ((tags (plist-get book :tags)))
|
|
(when tags
|
|
(mapconcat (lambda (tag) (concat ":" tag ":"))
|
|
tags " "))))
|
|
("rec_via" (plist-get book :rec_by))
|
|
("rating_display"
|
|
(when (and rating (> (length rating) 0))
|
|
(make-string (string-to-number rating) ?\u2605)))
|
|
("selected" selected)
|
|
("detail"
|
|
(when selected
|
|
(ht
|
|
("meta"
|
|
(let ((added (plist-get book :added))
|
|
(fmt (plist-get book :format)))
|
|
(cond
|
|
((and added fmt)
|
|
(format "started %s \302\267 %s" added fmt))
|
|
(added (format "started %s" added))
|
|
(fmt (format "format: %s" fmt))
|
|
(t ""))))
|
|
("notes"
|
|
(when notes
|
|
(cl-loop for (date text) in notes
|
|
collect (ht
|
|
("date" (format "[%s]" date))
|
|
("text" text))))))))
|
|
("minibuffer"
|
|
(when selected
|
|
(let ((status (plist-get book :status)))
|
|
(ht ("actions"
|
|
(append
|
|
(cond
|
|
((equal status "WANT")
|
|
(list
|
|
(ht ("command" "status") ("label" "Mark reading")
|
|
("href" (format "/edit?id=%s&action=status&value=READING" id)))
|
|
(ht ("command" "note") ("label" "Add note")
|
|
("href" (format "/edit?id=%s&action=note" id)))))
|
|
((equal status "READING")
|
|
(list
|
|
(ht ("command" "status") ("label" "Mark read")
|
|
("href" (format "/edit?id=%s&action=status&value=READ" id)))
|
|
(ht ("command" "status") ("label" "Abandon")
|
|
("href" (format "/edit?id=%s&action=status&value=ABANDONED" id)))
|
|
(ht ("command" "note") ("label" "Add note")
|
|
("href" (format "/edit?id=%s&action=note" id)))))
|
|
((equal status "READ")
|
|
(list
|
|
(ht ("command" "status") ("label" "Read again")
|
|
("href" (format "/edit?id=%s&action=status&value=READING" id)))
|
|
(ht ("command" "note") ("label" "Add note")
|
|
("href" (format "/edit?id=%s&action=note" id)))))
|
|
((equal status "ABANDONED")
|
|
(list
|
|
(ht ("command" "status") ("label" "Try again")
|
|
("href" (format "/edit?id=%s&action=status&value=READING" id)))))
|
|
(t nil))
|
|
nil))))))
|
|
)))
|
|
(push model book-models)))
|
|
(push (ht ("label" (cdr (assoc status status-labels)))
|
|
("count" (length group-books))
|
|
("books" (nreverse book-models)))
|
|
groups)))))))
|
|
(ht ("app_title" "spine")
|
|
("total_books" total)
|
|
("reading_count" reading-count)
|
|
("current_filter" effective-filter)
|
|
("summary_groups" (nreverse summary-groups))
|
|
("groups" (nreverse groups))))))
|
|
(defun spine-add-book (&rest args)
|
|
"Add a new WANT book to `spine-org-file'.
|
|
Keyword arguments: :title :author :category :format :isbn :cover
|
|
:rec_by :rec_note :date_added :initial_note
|
|
Signals an error on failure."
|
|
(let ((title (plist-get args :title))
|
|
(author (plist-get args :author))
|
|
(category (plist-get args :category))
|
|
(format (plist-get args :format))
|
|
(isbn (plist-get args :isbn))
|
|
(cover (plist-get args :cover))
|
|
(rec-by (plist-get args :rec_by))
|
|
(rec-note (plist-get args :rec_note))
|
|
(date-added (plist-get args :date_added))
|
|
(initial-note (plist-get args :initial_note)))
|
|
(unless title
|
|
(error "spine-add-book: title is required"))
|
|
(let ((org-file (expand-file-name spine-org-file)))
|
|
;; Create file if it doesn't exist
|
|
(unless (file-exists-p org-file)
|
|
(with-temp-file org-file
|
|
(insert "#+TODO: WANT(w) READING(r) | READ(d) ABANDONED(a)\n\n")))
|
|
(with-current-buffer (find-file-noselect org-file)
|
|
(unwind-protect
|
|
(progn
|
|
(goto-char (point-max))
|
|
;; Insert new headline
|
|
(org-insert-heading nil t)
|
|
(insert title)
|
|
;; Set TODO state
|
|
(org-todo "WANT")
|
|
;; Set properties (only non-empty)
|
|
(when (and author (> (length author) 0))
|
|
(org-set-property "AUTHOR" author))
|
|
(when (and format (> (length format) 0))
|
|
(org-set-property "FORMAT" format))
|
|
(when (and isbn (> (length isbn) 0))
|
|
(org-set-property "ISBN" isbn))
|
|
(when (and cover (> (length cover) 0))
|
|
(org-set-property "COVER" cover))
|
|
(when (and rec-by (> (length rec-by) 0))
|
|
(org-set-property "REC_BY" rec-by))
|
|
(when (and rec-note (> (length rec-note) 0))
|
|
(org-set-property "REC_NOTE" rec-note))
|
|
(when (and date-added (> (length date-added) 0))
|
|
(org-set-property "ADDED" (format "[%s]" date-added)))
|
|
;; Set ID
|
|
(org-set-property "ID"
|
|
(format "%04x-%s"
|
|
(random 65535)
|
|
(substring (sha1 (concat title (number-to-string (random)))) 0 4)))
|
|
;; Set tags
|
|
(when (and category (> (length category) 0))
|
|
(org-set-tags (list category)))
|
|
;; Add initial note
|
|
(when (and initial-note (> (length initial-note) 0))
|
|
(let ((date (if (and date-added (> (length date-added) 0))
|
|
date-added
|
|
(format-time-string "%Y-%m-%d"))))
|
|
(goto-char (org-entry-end-position))
|
|
(insert (format "\n- [%s] %s\n" date initial-note))))
|
|
(save-buffer)
|
|
t)
|
|
(kill-buffer))))))
|
|
|
|
(defun spine-set-status (id status)
|
|
"Set the TODO state of book with ID to STATUS.
|
|
STATUS should be one of: WANT, READING, READ, ABANDONED.
|
|
Signals an error if the book is not found."
|
|
(let ((org-file (expand-file-name spine-org-file)))
|
|
(unless (file-exists-p org-file)
|
|
(error "spine-set-status: file not found: %s" org-file))
|
|
(with-current-buffer (find-file-noselect org-file)
|
|
(unwind-protect
|
|
(progn
|
|
(org-element-map (org-element-parse-buffer 'headline) 'headline
|
|
(lambda (hl)
|
|
(when (= (org-element-property :level hl) 1)
|
|
(let ((pos (org-element-property :begin hl)))
|
|
(when (equal id (spine--prop pos "ID"))
|
|
(goto-char pos)
|
|
(org-todo status)))))
|
|
nil 'headline)
|
|
(unless (eq (point) (point-min))
|
|
(save-buffer)
|
|
t)
|
|
(when (eq (point) (point-min))
|
|
(error "spine-set-status: no book found with ID %s" id)))
|
|
(kill-buffer)))))
|
|
|
|
(defun spine-add-note (id text &optional date)
|
|
"Append a reading note to the book with ID.
|
|
TEXT is the note content. DATE is an optional YYYY-MM-DD string
|
|
\(defaults to today). Signals an error if the book is not found."
|
|
(let ((org-file (expand-file-name spine-org-file))
|
|
(date-str (or date (format-time-string "%Y-%m-%d"))))
|
|
(unless (file-exists-p org-file)
|
|
(error "spine-add-note: file not found: %s" org-file))
|
|
(with-current-buffer (find-file-noselect org-file)
|
|
(unwind-protect
|
|
(progn
|
|
(org-element-map (org-element-parse-buffer 'headline) 'headline
|
|
(lambda (hl)
|
|
(when (= (org-element-property :level hl) 1)
|
|
(let ((hl-id (spine--prop (org-element-property :begin hl) "ID")))
|
|
(when (equal id hl-id)
|
|
(goto-char (org-element-property :end hl))
|
|
(skip-chars-backward " \t\n")
|
|
(insert (format "\n- [%s] %s\n" date-str text))))))
|
|
nil 'headline)
|
|
(unless (eq (point) (point-min))
|
|
(save-buffer)
|
|
t)
|
|
(when (eq (point) (point-min))
|
|
(error "spine-add-note: no book found with ID %s" id)))
|
|
(kill-buffer)))))
|
|
|
|
(defun spine-set-rating (id rating)
|
|
"Set the RATING property of book with ID to RATING (1-5 string).
|
|
Signals an error if the book is not found."
|
|
(let ((org-file (expand-file-name spine-org-file)))
|
|
(unless (file-exists-p org-file)
|
|
(error "spine-set-rating: file not found: %s" org-file))
|
|
(with-current-buffer (find-file-noselect org-file)
|
|
(unwind-protect
|
|
(progn
|
|
(org-element-map (org-element-parse-buffer 'headline) 'headline
|
|
(lambda (hl)
|
|
(when (= (org-element-property :level hl) 1)
|
|
(let ((pos (org-element-property :begin hl)))
|
|
(when (equal id (spine--prop pos "ID"))
|
|
(goto-char pos)
|
|
(org-set-property "RATING" rating)))))
|
|
nil 'headline)
|
|
(unless (eq (point) (point-min))
|
|
(save-buffer)
|
|
t)
|
|
(when (eq (point) (point-min))
|
|
(error "spine-set-rating: no book found with ID %s" id)))
|
|
(kill-buffer)))))
|
|
(defun spine--extract-notes (hl-begin hl-end)
|
|
"Extract reading notes from headline body between HL-BEGIN and HL-END.
|
|
Returns list of (date-string text-string) pairs."
|
|
(let ((notes nil))
|
|
(save-excursion
|
|
(goto-char hl-begin)
|
|
;; Skip past PROPERTIES and LOGBOOK drawers
|
|
(while (re-search-forward
|
|
"^[ \t]*:\\(PROPERTIES\\|LOGBOOK\\):" hl-end t)
|
|
(re-search-forward "^[ \t]*:END:" hl-end t))
|
|
;; Collect note lines: "- [YYYY-MM-DD] text"
|
|
(while (re-search-forward
|
|
"^- \\[\\([0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}\\)\\] \\(.*\\)"
|
|
hl-end t)
|
|
(push (list (match-string 1) (match-string 2)) notes)))
|
|
(nreverse notes)))
|
|
|
|
|
|
(defun spine--prop (pos prop)
|
|
"Get Org property PROP at headline position POS.
|
|
Returns nil for empty or missing properties."
|
|
(let ((val (save-excursion
|
|
(goto-char pos)
|
|
(org-entry-get nil prop))))
|
|
(and val (> (length val) 0) val)))
|
|
(defun spine-books ()
|
|
"Return a list of plists, one per top-level headline in `spine-org-file'.
|
|
Returns nil if the file is missing or cannot be parsed."
|
|
(if (not (file-exists-p spine-org-file))
|
|
(progn
|
|
(message "spine-books: file not found: %s" spine-org-file)
|
|
nil)
|
|
(condition-case err
|
|
(with-temp-buffer
|
|
(insert-file-contents spine-org-file)
|
|
(org-mode)
|
|
(let ((books nil))
|
|
(org-element-map (org-element-parse-buffer 'headline) 'headline
|
|
(lambda (hl)
|
|
(when (= (org-element-property :level hl) 1)
|
|
(let ((pos (org-element-property :begin hl)))
|
|
(push (list :id (spine--prop pos "ID")
|
|
:title (org-element-property :title hl)
|
|
:status (org-element-property :todo-keyword hl)
|
|
:author (spine--prop pos "AUTHOR")
|
|
:isbn (spine--prop pos "ISBN")
|
|
:cover (spine--prop pos "COVER")
|
|
:format (spine--prop pos "FORMAT")
|
|
:rec_by (spine--prop pos "REC_BY")
|
|
:rec_note (spine--prop pos "REC_NOTE")
|
|
:rating (spine--prop pos "RATING")
|
|
:added (spine--prop pos "ADDED")
|
|
:tags (org-element-property :tags hl)
|
|
:notes (spine--extract-notes
|
|
(org-element-property :begin hl)
|
|
(org-element-property :end hl)))
|
|
books)))))
|
|
(nreverse books)))
|
|
(error
|
|
(message "spine-books: failed to parse %s: %s"
|
|
spine-org-file (error-message-string err))
|
|
nil))))
|
|
|
|
|
|
(defun spine-render-empty-state ()
|
|
"Render a page indicating no books file was found."
|
|
(concat "<!DOCTYPE html>\n<html lang=\"en\">\n<head>\n"
|
|
"<meta charset=\"utf-8\">\n"
|
|
"<meta name=\"viewport\" content=\"width=device-width, initial-scale=1\">\n"
|
|
"<title>Spine</title>\n"
|
|
"<link rel=\"stylesheet\""
|
|
" href=\"https://cdn.jsdelivr.net/npm/@picocss/pico@2/css/pico.min.css\">\n"
|
|
"</head>\n<body>\n"
|
|
"<main class=\"container\">\n"
|
|
"<article>\n"
|
|
"<header><strong>spine</strong></header>\n"
|
|
"<p>No books yet.</p>\n"
|
|
"</article>\n"
|
|
"</main>\n</body>\n</html>"))
|
|
|
|
(defvar spine-skip-server-start nil
|
|
"When non-nil, do not start the HTTP server.
|
|
Set by test harnesses that only need the model functions.")
|
|
|
|
;; --- handlers ---------------------------------------------------------
|
|
|
|
(defservlet index text/html (path query request)
|
|
(let* ((books (spine-books))
|
|
(filter (cadr (assoc "filter" query))))
|
|
(if books
|
|
(insert (spine-render "index.mustache"
|
|
(spine-index-model books filter (cadr (assoc "id" query)))))
|
|
(insert (spine-render-empty-state)))))
|
|
|
|
(defun httpd/add (proc uri-path query request)
|
|
"Handle /add: GET shows form, POST creates a book."
|
|
(let ((method (caar request)))
|
|
(if (equal method "POST")
|
|
(progn
|
|
(spine-add-book
|
|
:title (cadr (assoc "title" query))
|
|
:author (cadr (assoc "author" query))
|
|
:category (cadr (assoc "category" query))
|
|
:format (cadr (assoc "format" query))
|
|
:isbn (cadr (assoc "isbn" query))
|
|
:cover (cadr (assoc "cover" query))
|
|
:rec_by (cadr (assoc "rec_by" query))
|
|
:rec_note (cadr (assoc "rec_note" query))
|
|
:date_added (cadr (assoc "date_added" query))
|
|
:initial_note (cadr (assoc "initial_note" query)))
|
|
(httpd-redirect proc "/index" 303))
|
|
(httpd-with-buffer proc "text/html"
|
|
(let* ((books (spine-books))
|
|
(model (if books
|
|
(spine-add-form-model books)
|
|
(ht ("app_title" "spine")))))
|
|
(insert (spine-render "add.mustache" model)))))))
|
|
|
|
(defun httpd/edit (proc uri-path query request)
|
|
"Handle /edit: GET shows prompt page, POST processes actions.
|
|
Query params:
|
|
id - book ID
|
|
action - status | note | rating
|
|
value - target status / rating value (for status/rating actions)
|
|
text - note text (for note action)
|
|
date - optional date string (for note/read actions)"
|
|
(let ((method (caar request))
|
|
(id (cadr (assoc "id" query)))
|
|
(action (cadr (assoc "action" query)))
|
|
(value (cadr (assoc "value" query)))
|
|
(text (cadr (assoc "text" query)))
|
|
(date (cadr (assoc "date" query))))
|
|
(if (equal method "POST")
|
|
(progn
|
|
(cond
|
|
((equal action "note")
|
|
(spine-add-note id text date))
|
|
((equal action "status")
|
|
(spine-set-status id value))
|
|
((equal action "rating")
|
|
(spine-set-rating id value)))
|
|
(httpd-redirect proc (format "/index?id=%s" id) 303))
|
|
;; GET: show prompt page for actions needing input
|
|
(if (and id (equal action "note"))
|
|
(let* ((books (spine-books))
|
|
(book (cl-find id books :key (lambda (b) (plist-get b :id)) :test #'equal))
|
|
(title (if book (plist-get book :title) "Unknown")))
|
|
(httpd-with-buffer proc "text/html"
|
|
(insert (format
|
|
"<!DOCTYPE html>
|
|
<html lang=\"en\">
|
|
<head><meta charset=\"utf-8\"/><meta name=\"viewport\" content=\"width=device-width,initial-scale=1\"/>
|
|
<meta name=\"color-scheme\" content=\"light dark\"/>
|
|
<title>Spine — note</title>
|
|
<link rel=\"stylesheet\" href=\"https://cdn.jsdelivr.net/npm/@picocss/pico@2.1.1/css/pico.min.css\"/>
|
|
</head>
|
|
<body>
|
|
<main class=\"container\">
|
|
<article style=\"max-width:560px;margin-inline:auto;\">
|
|
<header><strong>spine · add note</strong></header>
|
|
<p><em>%s</em></p>
|
|
<form method=\"post\" action=\"/edit\">
|
|
<input type=\"hidden\" name=\"id\" value=\"%s\"/>
|
|
<input type=\"hidden\" name=\"action\" value=\"note\"/>
|
|
<label>Date <input type=\"date\" name=\"date\" value=\"%s\"/></label>
|
|
<label>Note <textarea name=\"text\" rows=\"3\" required autofocus></textarea></label>
|
|
<button type=\"submit\">Add note</button>
|
|
</form>
|
|
</article>
|
|
</main>
|
|
</body>
|
|
</html>"
|
|
title id (format-time-string "%Y-%m-%d"))))))
|
|
;; Unknown action or missing id: redirect to index
|
|
(httpd-redirect proc "/index" 302))))
|
|
(defun httpd/ (proc uri-path query request)
|
|
"Redirect root to /index."
|
|
(httpd-redirect proc "/index" 302))
|
|
|
|
;; --- start ------------------------------------------------------------
|
|
(unless spine-skip-server-start
|
|
(setq httpd-host spine-host)
|
|
(setq httpd-port spine-port)
|
|
(httpd-start)
|
|
(message "Spine listening on http://%s:%d"
|
|
(or spine-host "localhost") spine-port))
|
|
|
|
(provide 'spine)
|
|
;;; spine.el ends here
|