mirror of
https://codeberg.org/cage/tinmop/
synced 2025-01-21 03:15:35 +01:00
- [script] allowed all the template variable to be got from environment variables, when generating a gemlog.
- added fallback value for os-utils:getenv.
This commit is contained in:
cage
parent
d6b4eabc4c
commit
1322ad36b3
@ -14,6 +14,53 @@
|
||||
;; You should have received a copy of the GNU General Public License
|
||||
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
||||
|
||||
;; this script generates a gemlog starting from an archive directory
|
||||
;; containing posts in gemtext format
|
||||
|
||||
;; this script expect a bunch of input data to fill the gemlog templates.
|
||||
;; Such data can be provided by the environment variables given below:
|
||||
|
||||
;; - GEMLOG_HEADER
|
||||
;; The header of the gemlog
|
||||
;; - GEMLOG_TOPIC_INDEX_HEADER
|
||||
;; The header of the topic index page
|
||||
;; - GEMLOG_URI_PATH_PREFIX
|
||||
;; the root of the path for the gemlog (e.g: "gemini://example/cage/" → "/cage/"
|
||||
;; - GEMLOG_URI_POST_HOME_BACKLINK
|
||||
;; The URL added to the footer of each post
|
||||
;; - GEMLOG_URI_POST_HOME_BACKLINK_NAME
|
||||
;; The label for the URL added to the footer of each post
|
||||
;; - GEMLOG_URI_INDICES_HOME_BACKLINK
|
||||
;; The URL added to the footer of the gemlog and topic indices
|
||||
;; - GEMLOG_URI_HOME_INDICES_BACKLINK_NAME
|
||||
;; The label for the URL added to the footer of the gemlog and topic indices
|
||||
;; - GEMLOG_POSTS_SOURCE
|
||||
;; The source directory where the posts can be found to be processed by this script
|
||||
;; - GEMLOG_POSTS_DESTINATION
|
||||
;; the destination directory where the processed posts and generated indices are placed
|
||||
|
||||
;; METADATA
|
||||
|
||||
;; The source posts must contains metadata
|
||||
|
||||
;; the metadata must be wrapped in a preformatted block and the block's
|
||||
;; alt-text must be exactly the string "META". The metadata must be
|
||||
;; added one for line and contains a, colon separated, pair each.
|
||||
|
||||
;; So far the only valid metadata lines are:
|
||||
|
||||
;; - date: (the date of the post, format: YYY-MM-DD)
|
||||
;; - topics: The post's' topics: a comma separated list of strings
|
||||
|
||||
;; For example
|
||||
|
||||
;; […]
|
||||
|
||||
;; ``` META
|
||||
;; date: 2023-08-14
|
||||
;; topic: comics, cinema
|
||||
;; ```
|
||||
|
||||
(defpackage :generate-gemlog
|
||||
(:use :cl
|
||||
:misc
|
||||
@ -43,19 +90,58 @@
|
||||
|
||||
(a:define-constant +post-valid-file-extension+ "gmi$" :test #'string=)
|
||||
|
||||
(defparameter *gemlog-header* (format nil "# Posts~2%## Il gemlog di cage~2%"))
|
||||
(a:define-constant +environment-variable-gemlog-header+
|
||||
"GEMLOG_HEADER" :test #'string=)
|
||||
|
||||
(defparameter *topic-index-header* (format nil "# Topics archive~2%"))
|
||||
(a:define-constant +environment-variable-gemlog-topic-index-header+
|
||||
"GEMLOG_TOPIC_INDEX_HEADER" :test #'string=)
|
||||
|
||||
(defparameter *uri-prefix-path* "/")
|
||||
(a:define-constant +environment-variable-gemlog-uri-path-prefix+
|
||||
"GEMLOG_URI_PATH_PREFIX" :test #'string=)
|
||||
|
||||
(defparameter *post-home-backlink* "../index.gmi")
|
||||
(a:define-constant +environment-variable-gemlog-post-home-backlink+
|
||||
"GEMLOG_URI_POST_HOME_BACKLINK" :test #'string=)
|
||||
|
||||
(defparameter *post-home-backlink-name* "home")
|
||||
(a:define-constant +environment-variable-gemlog-post-home-backlink-name+
|
||||
"GEMLOG_URI_POST_HOME_BACKLINK_NAME" :test #'string=)
|
||||
|
||||
(defparameter *indices-home-backlink* "./index.gmi")
|
||||
(a:define-constant +environment-variable-gemlog-indices-home-backlink+
|
||||
"GEMLOG_URI_INDICES_HOME_BACKLINK" :test #'string=)
|
||||
|
||||
(defparameter *indices-home-backlink-name* "home")
|
||||
(a:define-constant +environment-variable-gemlog-indices-home-backlink-name+
|
||||
"GEMLOG_URI_HOME_INDICES_BACKLINK_NAME" :test #'string=)
|
||||
|
||||
(a:define-constant +environment-variable-gemlog-posts-archive+
|
||||
"GEMLOG_POSTS_SOURCE" :test #'string=)
|
||||
|
||||
(a:define-constant +environment-variable-gemlog-posts-destination+
|
||||
"GEMLOG_POSTS_DESTINATION" :test #'string=)
|
||||
|
||||
(defun getenv (key default)
|
||||
(os-utils:getenv key :default default))
|
||||
|
||||
(defparameter *gemlog-header*
|
||||
(getenv +environment-variable-gemlog-header+
|
||||
(format nil "# Posts~2%")))
|
||||
|
||||
(defparameter *topic-index-header*
|
||||
(getenv +environment-variable-gemlog-topic-index-header+
|
||||
(format nil "# Topics archive~2%")))
|
||||
|
||||
(defparameter *uri-path-prefix*
|
||||
(getenv +environment-variable-gemlog-uri-path-prefix+ nil))
|
||||
|
||||
(defparameter *post-home-backlink*
|
||||
(getenv +environment-variable-gemlog-post-home-backlink+ "../index.gmi"))
|
||||
|
||||
(defparameter *post-home-backlink-name*
|
||||
(getenv +environment-variable-gemlog-post-home-backlink-name+ "home"))
|
||||
|
||||
(defparameter *indices-home-backlink*
|
||||
(getenv +environment-variable-gemlog-indices-home-backlink+ "./index.gmi"))
|
||||
|
||||
(defparameter *indices-home-backlink-name*
|
||||
(getenv +environment-variable-gemlog-indices-home-backlink-name+ "home"))
|
||||
|
||||
(defun parse-date (timestring)
|
||||
(local-time:parse-timestring timestring))
|
||||
@ -234,6 +320,7 @@
|
||||
" "
|
||||
*post-home-backlink-name*))
|
||||
stream)
|
||||
(write-char #\Newline stream)
|
||||
(notify "Processed ~a~%" (original-file-path post)))
|
||||
(error (e)
|
||||
(format *error-output*
|
||||
@ -245,7 +332,7 @@
|
||||
(defun write-links (posts stream)
|
||||
(loop for post in posts do
|
||||
(let* ((filename (strip-dirs-from-path (archive-file-path post)))
|
||||
(relative-archive-path (strcat *uri-prefix-path*
|
||||
(relative-archive-path (strcat *uri-path-prefix*
|
||||
(cat-parent-dir +archive-dir+
|
||||
(percent-encode filename))))
|
||||
(link-text (strcat (format-date-to-string (post-date post))
|
||||
@ -267,12 +354,14 @@
|
||||
:if-does-not-exist :create
|
||||
:if-exists :supersede)
|
||||
(format gemlog-stream *gemlog-header*)
|
||||
(write-char #\Newline gemlog-stream)
|
||||
(write-links all-posts gemlog-stream)
|
||||
(format gemlog-stream "~%")
|
||||
(write-sequence (geminize-link (strcat *indices-home-backlink*
|
||||
" "
|
||||
*indices-home-backlink-name*))
|
||||
gemlog-stream))))
|
||||
gemlog-stream)
|
||||
(write-char #\Newline gemlog-stream))))
|
||||
|
||||
(defun make-topic-index (all-posts output-directory all-topics)
|
||||
(let ((topics-index-path (cat-parent-dir output-directory +archive-topic-file+)))
|
||||
@ -282,6 +371,7 @@
|
||||
:if-does-not-exist :create
|
||||
:if-exists :supersede)
|
||||
(write-sequence *topic-index-header* stream)
|
||||
(write-char #\Newline stream)
|
||||
(loop for topic in all-topics do
|
||||
(format stream "~a~2%" (geminize-h2 topic))
|
||||
(let ((in-topic-posts (remove-if-not (lambda (post)
|
||||
@ -295,7 +385,8 @@
|
||||
(write-sequence (geminize-link (strcat *indices-home-backlink*
|
||||
" "
|
||||
*indices-home-backlink-name*))
|
||||
stream))))
|
||||
stream)
|
||||
(write-char #\Newline stream))))
|
||||
|
||||
(defun generate-gemlog (bulk-posts-dir output-directory)
|
||||
(multiple-value-bind (all-posts all-topics)
|
||||
@ -307,32 +398,61 @@
|
||||
|
||||
(a:define-constant +output-dir-prompt+ "Output directory? " :test #'string=)
|
||||
|
||||
(a:define-constant +root-dir-prompt+ "Type the root of the path for the gemlog (e.g: \"gemini://foo.net/cage/\" → \"/cage/\") " :test #'string=)
|
||||
(a:define-constant +root-dir-prompt+ "Type the root of the path for the gemlog (e.g: \"gemini://example/cage/\" → \"/cage/\") " :test #'string=)
|
||||
|
||||
(defun generate-on-tui ()
|
||||
(let ((bulk-posts-dir nil)
|
||||
(output-directory nil))
|
||||
(let ((bulk-posts-dir (getenv +environment-variable-gemlog-posts-archive+ nil))
|
||||
(output-directory (getenv +environment-variable-gemlog-posts-destination+ nil)))
|
||||
(format t "Starting processing~%")
|
||||
(labels ((on-bulk-complete (input-text)
|
||||
(labels ((ask-output-directory ()
|
||||
(ui:ask-string-input #'on-out-complete
|
||||
:prompt +output-dir-prompt+
|
||||
:complete-fn #'complete:directory-complete))
|
||||
(ask-path-prefix ()
|
||||
(ui:ask-string-input #'on-root-completed
|
||||
:prompt +root-dir-prompt+))
|
||||
(generate ()
|
||||
(generate-gemlog bulk-posts-dir output-directory)
|
||||
(notify "Gemlog generated~%")
|
||||
(ui:open-gemini-address output-directory))
|
||||
(on-bulk-complete (input-text)
|
||||
(ui::with-enqueued-process ()
|
||||
(setf bulk-posts-dir input-text)
|
||||
(ui:ask-string-input #'on-out-complete
|
||||
:prompt +output-dir-prompt+
|
||||
:complete-fn #'complete:directory-complete)))
|
||||
(cond
|
||||
((null output-directory)
|
||||
(ask-output-directory))
|
||||
((null *uri-path-prefix*)
|
||||
(ui::with-enqueued-process ()
|
||||
(ask-path-prefix)))
|
||||
(t
|
||||
(generate)))))
|
||||
(on-out-complete (out-directory)
|
||||
(ui::with-enqueued-process ()
|
||||
(setf output-directory out-directory)
|
||||
(ui:ask-string-input #'on-root-completed
|
||||
:prompt +root-dir-prompt+)))
|
||||
(if (null *uri-path-prefix*)
|
||||
(ask-path-prefix)
|
||||
(generate))))
|
||||
(on-root-completed (root)
|
||||
(ui::with-enqueued-process ()
|
||||
(setf *uri-prefix-path* root)
|
||||
(setf *uri-path-prefix* root)
|
||||
(generate-gemlog bulk-posts-dir output-directory)
|
||||
(notify "Gemlog generated~%")
|
||||
(ui:open-gemini-address output-directory))))
|
||||
(ui:ask-string-input #'on-bulk-complete
|
||||
:prompt +bulk-dir-prompt+
|
||||
:complete-fn #'complete:directory-complete))))
|
||||
(cond
|
||||
((null bulk-posts-dir)
|
||||
(ui:ask-string-input #'on-bulk-complete
|
||||
:prompt +bulk-dir-prompt+
|
||||
:complete-fn #'complete:directory-complete))
|
||||
((null output-directory)
|
||||
(ui::with-enqueued-process ()
|
||||
(ask-output-directory)))
|
||||
((null *uri-path-prefix*)
|
||||
(ui::with-enqueued-process ()
|
||||
(ask-path-prefix)))
|
||||
(t
|
||||
(generate-gemlog bulk-posts-dir output-directory)
|
||||
(notify "Gemlog generated~%")
|
||||
(ui:open-gemini-address output-directory))))))
|
||||
|
||||
(defun ask-input-cli (prompt)
|
||||
(notify "~a~%" prompt)
|
||||
@ -341,7 +461,10 @@
|
||||
|
||||
(if (ui:tui-active-p)
|
||||
(generate-on-tui)
|
||||
(let* ((bulk-posts-dir (ask-input-cli +bulk-dir-prompt+))
|
||||
(output-directory (ask-input-cli +output-dir-prompt+)))
|
||||
(setf *uri-prefix-path* (ask-input-cli +root-dir-prompt+))
|
||||
(let* ((bulk-posts-dir (or (getenv +environment-variable-gemlog-posts-archive+ nil)
|
||||
(ask-input-cli +bulk-dir-prompt+)))
|
||||
(output-directory (or (getenv +environment-variable-gemlog-posts-destination+ nil)
|
||||
(ask-input-cli +output-dir-prompt+))))
|
||||
(when (null *uri-path-prefix*)
|
||||
(setf *uri-path-prefix* (ask-input-cli +root-dir-prompt+)))
|
||||
(generate-gemlog bulk-posts-dir output-directory)))
|
||||
|
||||
@ -49,15 +49,15 @@
|
||||
(misc:dbg "xdg-open: ~a" cmd-line)
|
||||
(uiop:launch-program cmd-line :output nil)))
|
||||
|
||||
(defun getenv (name)
|
||||
(nix:getenv name))
|
||||
(defun getenv (name &key (default nil))
|
||||
(or (nix:getenv name)
|
||||
default))
|
||||
|
||||
(defun default-temp-dir ()
|
||||
(or (os-utils:getenv "TMPDIR")
|
||||
"/tmp/"))
|
||||
(getenv "TMPDIR" :default "/tmp/"))
|
||||
|
||||
(defun pwd ()
|
||||
(os-utils:getenv "PWD"))
|
||||
(getenv "PWD"))
|
||||
|
||||
(defun external-editor ()
|
||||
(let* ((editor (or (swconf:external-editor)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user