Index section definitions for the Org-Roam-Blog Engine Package.
§ Index Root Spec (Type)
Elementary index type specificators.
At first I tried a "healthy" typed approach - as far as one can do it in lisp. But later realized that:
Elisp does not use type annotations for struct instance constructors.
The
defmethod
here cannot dispatch ondeftypes
But it can dispatch on
(head thing)
And that's what I need, because root specs are simple enough to be represented as
cons
-es (well,lists
in fact, for there can be extra parameters in the spec).
(defvar org-roam-blog--index-root-speclist '(all node query) "Spec symbols for ORB Index types.") (defun org-roam-blog--index-root-spec-p (thing) "Index Root has a form of cons cell: CAR is a spec symbol (for dispatch); rest is data for search." (and (consp thing) (member (car thing) org-roam-blog--index-root-speclist))) (deftype org-roam-blog-index-root-spec-type () '(satisfies org-roam-blog--index-root-spec-p))
§ Aux definitions for Index constructor
§ Root Spec Errors and Validation
Defining errors that might pop-up in the constructor.
(define-error 'org-roam-blog-index-root-error "ORB Index Error: Index Root should exist and be valid." 'org-roam-blog-errors) (define-error 'org-roam-blog-no-queries-error "ORB Error: Query Roots are not implemented yet." 'org-roam-blog-errors)
Validate the existence of the index root
object
(defun org-roam-blog--validate-root-spec (root-spec) (when (eql (car root-spec) 'query) (signal 'org-roam-blog-no-queries-error root-spec)) (or (eql (car root-spec) 'all) (and (eql (car root-spec) 'node) (org-roam-node-from-id (cadr root-spec)))))
§ Slug Builder
Uses handy utility defined in -utils
:
(defun org-roam-blog--slugify-default (string) "Indes slug-builder; defaults to calling `org-roam-blog-slugify'." (funcall #'org-roam-blog-slugify string))
§ Guess Index Title based on the root-spec
Title should be known during index construction. Either provided at start or populated from the root.
(cl-defgeneric org-roam-blog--guess-index-title (root-spec) "Tries to guess a title for index based on its ROOT-SPEC.") (cl-defmethod org-roam-blog--guess-index-title ((root-spec (head all))) "ORB Index Instance") (cl-defmethod org-roam-blog--guess-index-title ((root-spec (head node))) (org-roam-node-title (org-roam-node-from-id (cadr root-spec))))
§ Default sort and filter funcs
My handy and reasonable defaults for index filter-fn
and sort-fn
.
filter-fn
is a function to filter out nodes: it takes an org-roam-node
,
and when nil is returned the node will be filtered out.
sort-fn
is a predicate to sort org-roam-node
entries.
(defun org-roam-blog--filter-default (node) "Default node filtering function for index nodelist construction. T unless NODE tagged win `noexport'." (not (member "noexport" (org-roam-node-tags node)))) (defun org-roam-blog--sort-default (node1 node2) "Default node sorting key for index nodelist construction. Intended to leave nodes sorted in descending order w/r to date they were added; compares `org-timestamp' date field in the property set as `org-roam-blog-default-date-property' record of the nodes. T when NODE1 appears added later than NODE2, or if any of the nodes are missing `org-roam-blog-default-date-property' property (leaving them in place)." (let ((ds1 (cdr (assoc org-roam-blog-default-date-property (org-roam-node-properties node1)))) (ds2 (cdr (assoc org-roam-blog-default-date-property (org-roam-node-properties node2))))) (or (null ds1) (null ds2) (not (calendar-date-compare ; that thing needs lists of date-lists :/ (list (org-roam-blog-to-calendar-date ds1)) (list (org-roam-blog-to-calendar-date ds2)))))))
§ Definitions for context of Entries of an Index
The method in place of :entry-context-fn
of an index outputs a context
hash-table
object for an org-roam-node
representing an entry.
The following example has somewhat duplicating show-...
field in the
context in order to signal mustache.el templates that corresponding lists
must be rendered on page (syntax for lists and booleans in mustache is
the same).
(defun org-roam-blog--entry-context-default (node) "Default NODE to context hash-table processor." (let* ((lead-index (org-roam-node--lead-index-for (org-roam-node-id node))) (backlinks (org-roam-blog--backlinks-to-context node)) (date (cdr (assoc org-roam-blog-default-date-property (org-roam-node-properties node)))) (tags (mapcar (lambda (tag) (ht ("tag" tag))) (org-roam-node-tags node))) (toclevel (cdr (assoc org-roam-blog-toc-level-property (org-roam-node-properties node)))) (toc (when toclevel (org-roam-blog--toc-to-context node (string-to-number toclevel))))) (ht ("title" (org-roam-node-title node)) ("lead-index-title" (org-roam-blog-index-title lead-index)) ("backlinks" backlinks) ("show-backlinks" (when backlinks t)) ("toc" toc) ("show-toc" (when toc t)) ("date" date) ("show-date" (when date t)) ("tags" tags) ("show-tags" (when tags t)) ("self-url" (org-roam-blog--relative-entry-url node lead-index)) ("main" (org-roam-blog--htmlize-node-content node)))))
entry-fname-fn
outputs endpoint filename for output of an entry context.
(defun org-roam-blog--entry-fname-default (node) "Default filename builder for entry NODE object." (->> (org-roam-node-title node) (org-roam-blog-slugify) (format "%s.html")))
(defsubst org-roam-blog--entry-fname-with-date (node) "Alternative filename builder NODE object that prepends the entry date." (cl-labels ((datestring-to-slug-part (datestring) (let ((date (org-roam-blog-to-calendar-date datestring))) (cl-destructuring-bind (month day year) date (format "%4d-%02d-%02d-" year month day))))) (let ((datestring (cdr (assoc org-roam-blog-default-date-property (org-roam-node-properties node))))) (concatenate 'string (datestring-to-slug-part datestring) (org-roam-blog--entry-fname-default node)))))
§ Index Struct
By the way, type annotations in elisp
influence nothing.
Just a set of hints for self.
Heuristics for index file structure:
No
:template
or:context-fn
means no index content file is outputted. Suits for sections with only entry items' pages.No
:entry-dir
means no subdirectory for entry items is made. Entries than go to the corresponding index top subdirectory (defined by the:slug
field).
The group-by
field is intended for pagination.
It can be left set to 0
or non-~0~ integer.
(cl-defstruct (org-roam-blog-index (:constructor org-roam-blog-index--create) (:copier nil)) (root-spec nil :type org-roam-blog-index-root-spec-type) (title nil :type string) (slug nil :type string) (entry-dir org-roam-blog-default-entry-dir-name :type string) (media-dir org-roam-blog-default-media-dir-name :type string) (template nil :type string) (entry-template nil :type string) (slug-fn #'org-roam-blog--slugify-default :type function) (filter-fn #'org-roam-blog--filter-default :type function) (sort-fn #'org-roam-blog--sort-default :type function) (group-by 0 :type integer) (context-fn #'org-roam-blog--index-context-default :type function) (entry-context-fn #'org-roam-blog--entry-context-default :type function) (entry-fname-fn #'org-roam-blog--entry-fname-default :type function) (leading t :type boolean))
Index constructor definition.
(cl-defun org-roam-blog-index-create (&rest args) (condition-case err (let* ((index (apply #'org-roam-blog-index--create args)) (root-spec (org-roam-blog-index-root-spec index))) (unless (and root-spec (org-roam-blog--validate-root-spec root-spec)) (signal 'org-roam-blog-index-root-error root-spec)) (unless (org-roam-blog-index-title index) (setf (org-roam-blog-index-title index) (org-roam-blog--guess-index-title root-spec))) (unless (org-roam-blog-index-slug index) (setf (org-roam-blog-index-slug index) (funcall (org-roam-blog-index-slug-fn index) (org-roam-blog-index-title index)))) index) (org-roam-blog-errors (message "%s" (error-message-string err)) nil)))
§ Utilities for Blog Index processing
§ Entry list retrieving
Dispatch the preliminary (unfiltered) entry-list retriever.
Further implementation for queries
might speed the things up.
(cl-defgeneric org-roam-blog--entry-list-pre-builder (root-spec) "Initial entry list retriever based on the ROOT-SPEC.") (cl-defmethod org-roam-blog--entry-list-pre-builder ((root-spec (head all))) "Just returns `org-roam-node-list' function symbol to get all Roam's nodes." #'org-roam-node-list) (cl-defmethod org-roam-blog--entry-list-pre-builder ((root-spec (head node))) "Returned lambda gets entries' subheadings of the node's heading as Org-Roam nodes (generate and save their Id's when needed). The NODE ROOT-SPEC can specify entry heading offset other than 1 via :ENTRY-OFFSET keyword property." (lambda () (with-current-buffer (org-roam-node-find-noselect (org-roam-node-from-id (cadr root-spec)) t) (remove-if #'null (let ((root-level (org-current-level)) (entry-offset (or (getf root-spec :entry-offset) 1))) (org-map-entries (lambda () (when (= root-level (- (org-current-level) entry-offset)) (org-id-get-create) (when (buffer-modified-p) (save-buffer) (org-roam-db-update-file)) (org-roam-node-at-point))) nil 'tree))))))
Using previously defined dispatches, as well as filter-fn
and sort-fn
,
the following should return final entry node list for index.
(defun org-roam-blog--index-entry-list (index) "Return filtered list of Roam entries to be published for INDEX." (let* ((filter-fn (org-roam-blog-index-filter-fn index)) (sort-fn (org-roam-blog-index-sort-fn index)) (group-by (org-roam-blog-index-group-by index)) (nodes (funcall (org-roam-blog--entry-list-pre-builder (org-roam-blog-index-root-spec index)))) (nodes (cl-remove-if-not (lambda (n) (if filter-fn (funcall filter-fn n) t)) nodes)) (_ (when sort-fn (setq nodes (seq-sort sort-fn nodes))))) (if (zerop group-by) (list nodes) (seq-partition nodes group-by))))
§ Default Index context builder
Default index context builder returns a (paginated) list of context tables.
(defsubst org-roam-blog--index-context-default (index &optional entry-list) "Sample constructor of a context for INDEX. Set in \"context-fn\" field by default. Optionally accepts pre-built ENTRY-LIST." (let* ((title (org-roam-blog-index-title index)) (slug (org-roam-blog-index-slug index)) (entry-dir (org-roam-blog-index-entry-dir index)) (media-dir (org-roam-blog-index-media-dir index)) (entry-list (or entry-list (org-roam-blog--index-entry-list index))) (page-max (length entry-list))) (cl-loop for page-num from 1 for entry-group in entry-list collect (let ((entry-group (mapcar (org-roam-blog-index-entry-context-fn index) entry-group)) (prev-page (if (> page-num 1) (format "/%s/%s-%s.html" slug org-roam-blog-index-filename-prefix (1- page-num)) "")) ; must result in a string to render in mustache (next-page (if (< page-num page-max) (format "/%s/%s-%s.html" slug org-roam-blog-index-filename-prefix (1+ page-num)) ""))) ; must result in a string to render in mustache (ht ("title" title) ("slug" slug) ("entry-dir" entry-dir) ("media-dir" media-dir) ("entries" entry-group) ("page" page-num) ("page-max" page-max) ("prev-page" prev-page) ("has-prev-page" (not (string-empty-p prev-page))) ("next-page" next-page) ("has-next-page" (not (string-empty-p next-page))))))))
§ Entry context list
(defsubst org-roam-blog--build-entry-context-list (index &optional entry-list) "Prototype function to get a list of entry contexts for INDEX publishing. Optionally accepts pre-built grouped ENTRY-LIST, meant be flattened." (cl-loop for node in (flatten-list (or entry-list (org-roam-blog--index-entry-list index))) collect (list node (funcall (org-roam-blog-index-entry-context-fn index) node))))
§ TODO Also grab counters for the context here
As logic for index page numbering also goes.
§ Entry relative path (URL)
Definitions that allow to get relative path of an entry inside the resulting site file structure - that for static pages also serves as URL.
(defsubst org-roam-blog--subdir-for-index (index) "Return relative subdirectory for entry outputs for the INDEX inside the staging directory." (if-let ((index-slug (org-roam-blog-index-slug index)) (entry-dir (org-roam-blog-index-entry-dir index))) (concat index-slug "/" entry-dir) index-slug)) (defsubst org-roam-blog--relative-entry-url (node index) "Output relative entry url path for an entry defined by NODE and an INDEX, implying that this INDEX is a leading one for the NODE." (let ((fname (funcall (org-roam-blog-index-entry-fname-fn index) node)) (subdir (org-roam-blog--subdir-for-index index))) (string-trim (concat "/" subdir "/" fname))))