luv

Workshop wiki

cli.lisp

wiki/cli.lisp

system luv-wiki/cli · 36 definitions · on GitHub

The ./wiki command: the wiki corpus from a shell.

A small executable built with ASDF's program-op, for agents and people who want the table of contents, the work marks, a figure's text, or the places something is mentioned without opening Emacs or a browser. It reads the same objects the site is rendered from, so what it prints agrees with what the site shows.

defpackage#:luv.wiki.cli
:use#:cl
:local-nicknames
#:wiki#:luv.wiki
:export#:main#:run
in-package#:luv.wiki.cli
defvar*build-source-registry*nil"CL_SOURCE_REGISTRY as seen when the executable was built."
defvar*build-output-translations*nil"ASDF_OUTPUT_TRANSLATIONS as seen when the executable was built."
defvar*build-sbcl-home*nil"SBCL's home directory at build time, where its contrib modules live."
defuncapture-asdf-configuration

Remember the ASDF environment of the build, so that the executable can find systems and their compiled files without the sbcl wrapper's environment, and SBCL's home so that (require :sb-concurrency) and other contribs still work from an executable outside SBCL's own directory. Called by wiki/build.lisp before the image is dumped.

setf*build-source-registry*
uiop:getenv"CL_SOURCE_REGISTRY"
*build-output-translations*
uiop:getenv"ASDF_OUTPUT_TRANSLATIONS"
*build-sbcl-home*
sb-int:sbcl-homedir-pathname
defunrestore-asdf-configuration

Re-establish the build's ASDF configuration in the running executable. The Nix shell sets a smaller CL_SOURCE_REGISTRY of its own (the sbcl wrapper adds the packaged systems only for sbcl processes), so the captured configuration is used whenever it exists.

when
and*build-sbcl-home*
null
sb-int:sbcl-homedir-pathname
setfsb-sys::*sbcl-homedir-pathname**build-sbcl-home*
when*build-output-translations*
asdf:initialize-output-translations*build-output-translations*
when*build-source-registry*
asdf:initialize-source-registry*build-source-registry*
defvar*root*nil"The repository root: the directory holding the primary ASD files and wiki/."
defunroot
or*root*
setf*root*
uiop:ensure-directory-pathname
or
uiop:getenv"LUV_ROOT"
uiop:getcwd
defunensure-systems

Register every repository-owned system so the source scan knows its files.

dolist
name'
"luv.asd""mqtt.asd""openai.asd""luvcraft.asd""telegram.asd""luft.asd""luv-wiki.asd""luv-wiki-site.asd"
asdf:load-asd
merge-pathnamesname
defvar*site*nil
defunsite
&key
codet

The site over the wiki pages, and over the source files unless code is NIL.

or*site*
setf*site*
let*
wiki
merge-pathnames"wiki/"
documents
mapcar#'wiki:read-org-file
sort
directory
merge-pathnames"*.org"wiki
#'string<:key#'pathname-name

index.org first, then the rest as on the site.

setfdocuments
append
remove"index"documents:key#'wiki:document-name:test-not#'string=
remove"index"documents:key#'wiki:document-name:test#'string=
wiki::load-arglists
merge-pathnames"wiki/arglists.sexp"
let
sources
wiki:make-sitedocuments:source-filessources:systems:source-directory

Plain text

defuninline-text
inlines
defunfill-text
text&key
indent0

Reflow text into lines of at most width columns with indent spaces.

let
words
uiop:split-stringtext:separator'
#\Space#\Newline#\Tab
line'
lengthindent
lines'
flet
flush
whenline
push
formatnil"~v@T~{~A~^ ~}"indent
nreverseline
lines
setfline'
lengthindent
dolist
word
remove""words:test#'string=
when
flush
pushwordline
incflength
+1
lengthword
flush
formatnil"~{~A~^~%~}"
nreverselines
defgenericelement-text
element&keyindent
:documentation

element as plain text for a terminal.

:method
stringstring
&key
indent0
fill-textstring:indentindent
:method
fill-text
inline-text
wiki:element-childrenparagraph
:indentindent
:method
&key
indent0
formatnil"~{~A~^~%~}"
loopforitemin
wiki:element-childrenlist
fornfrom1collect
let
bullet
if
wiki:plain-list-ordered-plist
formatnil"~D."n
"-"
formatnil"~v@T~A ~A"indentbullet
string-left-trim" "
element-textitem:indent
+indent2
:method
&key
indent0
formatnil"~{~A~^~%~}"
mapcar
lambda
child
element-textchild:indentindent
wiki:element-childrenitem
:method
&key
indent0
formatnil"~{~v@T~A~^~%~}"
loopforlinein
uiop:split-string
wiki:block-textblock
:separator'
#\Newline
collectindentcollectline
:method
&key
indent0
formatnil"~{~v@T~A~^~%~}"
loopforrowin
wiki:table-rowstable
collectindentcollect
formatnil"~{~A~^ | ~}"
mapcar#'inline-textrow
:method
declare
ignoreindent
""
defundefinition-place

FILE:LINE with the file relative to the repository root.

formatnil"~A:~D"
namestring
uiop:enough-pathname
wiki::definition-pathnamedefinition
wiki:definition-linedefinition
defunheading-line
formatnil"~@[~A ~]~A"
wiki:heading-keywordheading
inline-text
wiki:heading-titleheading
defunsection-text

The prose of heading's own section, without subheadings.

formatnil"~{~A~^~%~%~}"
loopforchildin
wiki:element-childrenheading
unless
typepchild'wiki:heading
collect

Commands

defvar*commands*'
"Alist of (name docstring function)."
defmacrodefine-command
name
&restlambda-list
documentation&bodybody
`
progn
defun,name,lambda-list,documentation,@body
setf*commands*
append
remove',name*commands*:key#'third
list
list,
string-downcase
symbol-namename
,documentation',name
define-commandhelp
&restarguments
"Show this help."
declare
ignorearguments
formatt"usage: wiki COMMAND [ARGUMENTS]~%~%"
loopforin*commands*do
formatt" ~12A ~A~%"name
first
uiop:split-stringdocumentation:separator'
#\Newline
define-commandtoc
&restnames

Table of contents: every page with its figures, IDs, and work marks. Give page names to restrict.

dolist
document
wiki:site-documents
site:codenil
when
or
nullnames
member
wiki:document-namedocument
names:test#'string=
formatt"~&~A (~A.org)~%"
wiki:document-namedocument
terpri
defparameter*status-order*'
"NEXT""TODO""WAIT""IDEA""DONE"
define-commandmarks
&reststatuses
"Work marks by status: NEXT, TODO, WAIT, IDEA, DONE. Give statuses to restrict."
let
statuses
or
mapcar#'string-upcasestatuses
*status-order*
dolist
document
wiki:site-documents
site:codenil
setfmarks
nreversemarks
dolist
statusstatuses
let
these
removestatusmarks:key#'wiki:heading-keyword:test-not#'string=
whenthese
formatt"~&~A~%"status
dolist
markthese
formatt" ~A ~A (~A)~%"
inline-text
wiki:heading-titlemark
wiki:document-name
wiki:heading-documentmark
terpri
defunprint-figure
let
formatt"~&~A ~A~%~A.org, level ~D~%~%"id
wiki:document-name
wiki:heading-documentfigure
wiki:heading-levelfigure
let
when
plusp
lengthtext
formatt"~A~%~%"text
let
children
remove-if-not
lambda
c
wiki:element-childrenfigure
whenchildren
formatt"Subheadings:~%"
dolist
childchildren
formatt" ~@[~A ~]~A~%"
terpri
let
backlinks
gethashid
wiki:site-backlinkssite
whenbacklinks
formatt"Mentioned in:~%"
dolist
otherbacklinks
formatt" ~A ~A (~A)~%"
wiki:document-name
wiki:heading-documentother
terpri
let
references
gethashid
wiki:site-code-referencessite
whenreferences
formatt"Referenced from code:~%"
dolist
definitionreferences
formatt" ~A ~A~{ ~A~} ~A~%"
wiki:definition-kinddefinition
wiki:definition-namedefinition
wiki:definition-qualifiersdefinition
terpri
define-commandfigure
&restids
"Print figures by ID: title, page, text, subheadings, backlinks, code references."
let
dolist
idids
let
iffigure
formatt"~&No figure ~A~%"id
define-commandpage
&restnames
"Print whole pages as text."
let
dolist
namenames
let
document
findname
wiki:site-documentssite
:key#'wiki:document-name:test#'string=
ifdocument
progn
dolist
child
wiki:element-childrendocument
if
typepchild'wiki:heading
wiki::map-elements
lambda
e
when
formatt"~v@{*~} ~A~@[ #~A~]~%~%"
wiki:heading-levele
nil
let
when
plusp
lengthtext
formatt"~A~%~%"text
child
formatt"~A~%~%"
formatt"~&No page ~A~%"name
define-commandmentions
&restids
"Where figures are mentioned: other figures and code definitions."
let
dolist
idids
let*
id
string-upcaseid
backlinks
gethashid
wiki:site-backlinkssite
references
gethashid
wiki:site-code-referencessite
formatt"~&~A~%"id
dolist
otherbacklinks
formatt" ~A ~A (~A)~%"
wiki:document-name
wiki:heading-documentother
dolist
definitionreferences
formatt" ~A ~A ~A~%"
wiki:definition-kinddefinition
wiki:definition-namedefinition
unless
orbacklinksreferences
formatt" (nowhere)~%"
define-commanddangling
&restarguments
"Mentions in pages and code that no figure resolves."
declare
ignorearguments
let
loopforindo
formatt"~&~A.org: ~{~A~^ ~}~%"
wiki:document-namedocument
ids
loopforindo
formatt"~&~A ~A (~A): ~{~A~^ ~}~%"
wiki:definition-kinddefinition
wiki:definition-namedefinition
ids
define-commanddefs
&restnames
"Definitions in the source whose name contains each NAME (case-insensitive)."
let
dolist
namenames
dolist
definition
wiki:site-definitionssite
when
searchname
wiki:definition-namedefinition
:test#'char-equal
formatt"~&~A ~A~{ ~A~} ~A~@[ ~{#~A~^ ~}~]~%"
wiki:definition-kinddefinition
wiki:definition-namedefinition
wiki:definition-qualifiersdefinition
wiki:definition-mentionsdefinition
defparameter*id-characters*

ABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789

define-commandids
&optional
count"12"

Print COUNT fresh figure IDs that no page uses (default 12); never six hex digits, which the reader takes for a colour.

let*
site
site:codenil
used
wiki:site-figuressite
state
make-random-statet
dotimes
i
parse-integercount
loopforcandidate=
coerce'string
unless
or
gethashcandidateused
find-symbolcandidate:keyword
do
setf
gethashcandidateused
t
formatt"~A~%"candidate
defparameter*introspection-systems*'
"luv""luvcraft""luv-wiki""luft/render"
"Systems loaded before gathering operator lambda lists."
define-commandintrospect
&restsystems

Load the luv systems into this process and write the real lambda lists of every operator the sources use to wiki/arglists.sexp, for the renderer's derived layouts. Give system names to load others instead.

dolist
formatt"~&loading ~A~%"name
asdf:load-systemname
let*
pathname
merge-pathnames"wiki/arglists.sexp"
formatt"~&~D operators written to ~A~%"countpathname
define-commandbuild
&restarguments
"Render the site into build/wiki/ with (asdf:make :luv-wiki-site)."
declare
ignorearguments
asdf:make:luv-wiki-site
formatt"~&~A~%"
wiki:site-output-directory
asdf:find-system:luv-wiki-site
defunrun
arguments

Run the command named by the first of arguments.

let*
name
or
firstarguments
"help"
command
assocname*commands*:test#'string-equal
ifcommand
apply
thirdcommand
restarguments
progn
format*error-output*"wiki: unknown command ~A~%"name
defunmain

Entry point of the built executable.

handler-case
progn
run
uiop:command-line-arguments
finish-output
error
condition
format*error-output*"~&wiki: ~A~%"condition