luv

Workshop wiki

html.lisp

wiki/html.lisp

system luv-wiki · 68 definitions · on GitHub

Rendering the wiki corpus as a static HTML site with Spinneret.

A site holds every document of the corpus together with the figure index derived from their headings: which page owns each ID, and which figures mention which. render-html is the generic that emits Spinneret markup for an element while *SITE* supplies cross-page resolution.

in-package#:luv.wiki
defclasssite
documents:initarg:documents:initform'
:accessorsite-documents
source-files:initarg:source-files:initform'
:accessorsite-source-files:documentation"SOURCE-FILEs of the systems the site browses."
systems:initarg:systems:initform'
:accessorsite-systems:documentation"SYSTEM-ENTRYs in dependency order, for the source index."
definitions:initarg:definitions:initform'
:accessorsite-definitions:documentation"DEFINITIONs read from the source files, if any."
definition-table:initform
make-hash-table:test'equalp
:accessorsite-definition-table:documentation"Bare definition name -> list of DEFINITIONs."
code-references:initform
make-hash-table:test'equal
:accessorsite-code-references:documentation"Figure ID -> list of DEFINITIONs mentioning it."
figures:initform
make-hash-table:test'equal
:accessorsite-figures:documentation"Figure ID -> HEADING."
backlinks:initform
make-hash-table:test'equal
:accessorsite-backlinks:documentation"Figure ID -> list of HEADINGs whose text mentions it."
source-url:initarg:source-url:initform"https://github.com/mbrock/luv/blob/main/":accessorsite-source-url:documentation"Base URL for file: links into the repository."
source-directory:initarg:source-directory:initformnil:accessorsite-source-directory:documentation"The repository root that SOURCE-URL corresponds to."
:documentation

The whole wiki corpus and its disposable derived indexes.

defvar*site*nil"The SITE whose indexes resolve mentions and links while rendering."
defunmake-site
documents&restinitargs

Build a site over documents and index their figures and mentions.

let
site
apply#'make-instance'site:documentsdocumentsinitargs
dolist
documentdocuments
dolist
documentdocuments
dolist
dolist
id
remove-duplicates:test#'equal
unless
pushfigure
gethashid
site-backlinkssite
maphash
lambda
idfigures
setf
gethashid
site-backlinkssite
nreversefigures
site-backlinkssite
unless
site-definitionssite
setf
site-definitionssite
loopforfilein
site-source-filessite
append
source-file-definitionsfile
setf
site-code-referencessite
dolist
definition
site-definitionssite
pushdefinition
gethash
bare-name
definition-namedefinition
site-definition-tablesite
maphash
lambda
namelist
setf
gethashname
site-definition-tablesite
nreverselist
site-definition-tablesite
site
defunbare-name
name

name without any package prefix: "luv.wiki:foo" -> "foo".

let
colon
position#\:name:from-endt
ifcolon
subseqname
1+colon
name
defunfind-named-definition
name&optional

The best definition for the bare symbol name: a defining form of the generic, function, macro, or class before any method, else the first.

let
candidates
andsite
gethash
site-definition-tablesite
or
find-if
lambda
d
member
definition-kindd
'
"defgeneric""defun""defmacro""defclass""defstruct""defvar""defparameter""defconstant""define-condition"
:test#'string=
candidates
firstcandidates
defuntest-definition-p

Is definition in a file of a test system? Tests fabricate figure IDs to exercise the reader, so their mentions are not expected to resolve.

let
andfile
source-file-system-namefile
search"/test"
source-file-system-namefile
t
defundangling-code-mentions

An alist of (definition . ids) for code mentions no figure resolves, leaving out the definitions of test systems.

loopfordefinitionin
site-definitionssite
fordangling=whendanglingcollect
defunfind-figure
id&optional
andsite
gethashid
site-figuressite
defunsite-page-name
concatenate'string
document-namedocument
".html"
defunfigure-href
id&keyfrom

The href for figure id from the page from (a document), or NIL if dangling.

let
whenfigure
let
document
heading-documentfigure
if
andfrom
eqdocumentfrom
formatnil"#~A"id
defunmap-inlines

Call function on every inline object reachable from block element, including headings' titles and table cells, but not into subheadings.

labels
walk-inlines
inlines
dolist
xinlines
unless
stringpx
funcallfunctionx
when
walk-inlines
element-childrenx
walk
typecaseelement
heading
walk-inlines
heading-titleelement
paragraph
walk-inlines
element-childrenelement
table
dolist
row
table-rowselement
mapc#'walk-inlinesrow
unless
dolist
child
element-childrenelement
unless
typepchild'heading
walkchild
defunheading-mentions

IDs referred to in heading's own section text, not its subheadings.

let
map-inlines
lambda
inline
let
id
whenid
pushidids
heading
nreverseids
defundocument-mentions

All figure IDs mentioned anywhere in document, in document order.

let
labels
collect
map-inlines
lambda
inline
let
id
whenid
pushidids
element
walk
if
progn
collectelement
dolist
child
element-childrenelement
when
typepchild'heading
walkchild
collectelement
mapc#'walk
element-childrendocument
remove-duplicates
nreverseids
:test#'equal:from-endt
defundangling-mentions

An alist of (document . ids) for mentions no figure in site resolves.

loopfordocumentin
site-documentssite
fordangling=whendanglingcollect

Rendering

defvar*rendering-document*nil"The document whose page is being rendered; makes same-page links relative."
defvar*page-prefix*

NIL

The relative path from the page being rendered back to the site root, "" for top-level pages and "../" or deeper for source pages.

defgenericrender-html
:documentation

Emit Spinneret markup for element into SPINNERET:*html*. Strings are plain text; each element and inline class contributes its own method.

defmethodrender-html:around

Spinneret passes the value of every body form to SPINNERET:HTML, whose default method still emits a pending space for a non-NIL object. Rendering is for effect only, so return nothing.

call-next-method
values
defmethodrender-html
stringstring

SPINNERET:HTML is Spinneret's own generic for writing an object as escaped text; a bare form at the top of WITH-HTML is not printed.

spinneret:htmlstring
defunrender-inlines
inlines
mapc#'render-htmlinlines
values
defmethodrender-html
mapc#'render-html
element-childrenelement
defmethodrender-html
let
inlines
remove-if
lambda
x
element-childrenparagraph
spinneret:with-html

A paragraph containing only media is a figure of its own.

cond
and
=
lengthinlines
1
typep
firstinlines
'link
capture-link-p
firstinlines
and
=
lengthinlines
1
typep
firstinlines
'link
image-link-p
firstinlines
:figure.image
:img:src
link-path
firstinlines
:alt""
and
=
lengthinlines
1
typep
firstinlines
'link
link-definition
firstinlines
t
:p
render-inlines
element-childrenparagraph
defmethodrender-html
spinneret:with-html
if
plain-list-ordered-plist
:ol
mapc#'render-html
element-childrenlist
:ul
mapc#'render-html
element-childrenlist
defmethodrender-html
spinneret:with-html
:li
let
children
element-childrenitem

A single paragraph item renders inline; richer items keep blocks.

if
and
=
lengthchildren
1
typep
firstchildren
'paragraph
render-inlines
element-children
firstchildren
mapc#'render-htmlchildren
defmethodrender-html
spinneret:with-html
:pre.example
block-textblock
defmethodrender-html
let
language
src-block-languageblock
cond
equallanguage"lisp"
render-lisp-source
block-textblock
equallanguage"mermaid"

Mermaid draws these at load time; the text remains readable.

spinneret:with-html
:pre.mermaid
block-textblock
t
spinneret:with-html
:pre.src:data-languagelanguage
:code
block-textblock
defmethodrender-html
spinneret:with-html
:table
loopforrowin
table-rowstable
forfirst=tthennildo
:tr
dolist
cellrow
defparameter*emphasis-tags*'
:bold"b"
:italic"i"
:underline"u"
:strike"s"
:verbatim"code""verbatim"
:code"code"
"HTML tag and optional class for each emphasis kind."
defmethodrender-html
destructuring-bind
tag&optionalclass
cdr
assoc
emphasis-kindemphasis
*emphasis-tags*
spinneret:with-html
:tag:nametag:classclass
render-inlines
element-childrenemphasis
defmethodrender-html

TeX source in a .math element; site.js renders it with KaTeX.

spinneret:with-html
if
math-display-pmath
:div.math.display
math-textmath
:span.math
math-textmath
defmethodrender-html
let*
spinneret:with-html
ifhref
:a.mention:hrefhref:title
inline-text
heading-titlefigure
formatnil"#~A"id
:span.mention.dangling:title"No figure has this ID"
formatnil"#~A"id
defgenericlink-href
protocollink
:documentation

The href to use for link whose scheme is protocol (a keyword or NIL), or NIL when the link cannot be resolved into the site.

:method
protocolt
nil
defmethodlink-href
protocol
eql:https
link
formatnil"https:~A"
link-pathlink
defmethodlink-href
protocol
eql:http
link
formatnil"http:~A"
link-pathlink
defmethodlink-href
protocol
eql:id
link
defparameter*image-types*'
"png""jpg""jpeg""gif""svg""webp"
defparameter*video-types*'
"mp4""webm"
defuncapture-link-p

True when link safely names generated media under the site's media cache.

let
path
link-pathlink
and
equal
link-protocollink
"capture"
null
element-childrenlink
plusp
lengthpath
every
lambda
character
or
alphanumericpcharacter
findcharacter"-_."
path
or
member
pathname-typepath
*image-types*:test#'string-equal
member
pathname-typepath
*video-types*:test#'string-equal
defunrender-capture-link

Transclude a generated image or video without requiring its bytes at build time.

let*
path
link-pathlink
type
string-downcase
pathname-typepath
source
concatenate'string*page-prefix*"media/"path
spinneret:with-html
if
membertype*image-types*:test#'string=
:figure.capture.image
:img:srcsource:alt"":loading"lazy"
:figure.capture.video
:video:controlst:loopt:mutedt:preload"metadata"
:source:srcsource:type
formatnil"video/~A"type
"This browser cannot play the captured video."
defunimage-link-p

True for a bare file: link to an image inside the wiki directory.

and
equal
link-protocollink
"file"
null
element-childrenlink
not
starts-with"../"
link-pathlink
member
pathname-type
link-pathlink
*image-types*:test#'string-equal
defmethodlink-href
protocol
eql:file
link

A file: link to another wiki page becomes a page link; a link into the repository points at the source on GitHub; anything else is unresolved.

let*
path
link-pathlink
org-p
and
>
lengthpath
4
string=".org"path:start2
-
lengthpath
4
cond
andorg-p
not
find#\/path
concatenate'string*page-prefix*
subseqpath0
-
lengthpath
4
".html"
starts-with"../../"path
nil
starts-with"../"path
concatenate'string
site-source-url*site*
subseqpath3
tnil
defunlink-definition

The definition a lisp: link names, or NIL.

and*site*
equal
link-protocollink
"lisp"
find-definition
link-pathlink
site-definitions*site*
defundefinition-source-url
formatnil"~A~A#L~D"
site-source-url*site*
uiop:enough-pathname
definition-pathnamedefinition
site-source-directory*site*
definition-linedefinition
defunrender-definition
definition&keyopen

A disclosure block: the definition's head, file, and source link as the summary, and the form drawn as dexp boxes inside.

spinneret:with-html
:details.definition:openopen
:summary
:span.kind
definition-kinddefinition
" "
:span.name
definition-namedefinition
dolist
qualifier
definition-qualifiersdefinition
spinneret:html" "
:span.qualifierqualifier
" "
when
spinneret:html" "
:a.github:href:title"On GitHub""↗"
render-lisp-nodes
append
definition-commentsdefinition
list
definition-nodedefinition
:package
definition-packagedefinition
defmethodlink-href
protocolnull
link

A bare target with no scheme is a wiki page name if a page exists.

let
name
link-pathlink
when
and*site*
findname
site-documents*site*
:key#'document-name:test#'string=
concatenate'string*page-prefix*name".html"
defmethodrender-html
let*
protocol
and
link-protocollink
intern
string-upcase
link-protocollink
:keyword
href
description
or
element-childrenlink
list
link-pathlink
spinneret:with-html
cond
:img.inline:src
link-pathlink
:alt""
and
eqprotocol:id
null
element-childrenlink

A bare #X reads like the light mention #X.

render-html
make-instance'mention:id
link-pathlink
href
:a:hrefhref
render-inlinesdescription
t
:span.unresolved-link:title
formatnil"~@[~A:~]~A"
link-protocollink
link-pathlink
render-inlinesdescription
defunrender-heading-title
spinneret:with-html
when
heading-keywordheading
:span:class
formatnil"mark mark-~(~A~)"
heading-keywordheading
heading-keywordheading
spinneret:html" "
defmethodrender-html
let*
backlinks
andid
gethashid
site-backlinks*site*
references
andid
gethashid
site-code-references*site*
spinneret:with-html
:section:idid:class
if
heading-keywordheading
"figure work-mark""figure"
:h*
whenid
spinneret:html" "
:a.figure-id:href
formatnil"#~A"id
:title"Permalink to this figure"
formatnil"#~A"id
dolist
child
element-childrenheading
unless
typepchild'heading
whenbacklinks
:p.backlinks"Mentioned in: "
loopforfigureinbacklinksforfirst=tthennildo
unlessfirst
spinneret:html", "
whenreferences
:div.code-references
:p.backlinks"Referenced from code:"
dolist
child
element-childrenheading
when
typepchild'heading
defvar*page-kind*

page

"A short word for the status bar: what kind of page is being rendered."
defunrender-crumbs
crumbs

The breadcrumb trail of the status bar: crumbs is a list of (label . href), the last one the current page, its href ignored.

spinneret:with-html
:nav.crumbs:aria-label"Breadcrumb"
loopfor
crumb.rest
oncrumbsforfirst=tthennildo
unlessfirst
:span.crumb-sep:aria-hidden"true""›"
if
andrest
cdrcrumb
:a.crumb:href
concatenate'string*page-prefix*
cdrcrumb
carcrumb
:span.crumb.current:aria-current"page"
carcrumb
defunrender-page-frame
titlebody&keybody-class
crumbs
list
constitlenil
rightkind

Emit a whole HTML page with the site chrome around the output of body: the library band with the site's three doors, a status bar with the page's breadcrumb trail on the left and right (a string, or a function emitting markup) on the right, the main column, and a footer.

flet
href
name
concatenate'string*page-prefix*name
spinneret:with-html
:doctype
:html:lang"en"
:head
:meta:charset"utf-8"
:meta:name"viewport":content"width=device-width, initial-scale=1"
:titletitle
:link:rel"preconnect":href"https://fonts.googleapis.com"
:link:rel"preconnect":href"https://fonts.gstatic.com":crossorigin""
:link:rel"stylesheet":href"https://fonts.googleapis.com/css2?family=Public+Sans:ital,wght@0,100..900;1,100..900&display=swap"
:link:rel"stylesheet":href
href"style.css"
:script:src
href"site.js"
:defert
:body:classbody-class
:header.library
:div.library-heading
:p.eyebrow"luv"
:h1
:a:href
href"index.html"
"Workshop wiki"
:nav.doors
:a:class
if
memberkind'
"page""pages"
:test#'equal
"door selected""door"
:href
href"pages.html"
:span.door-title"Pages"
:span.door-meta
formatnil"~D pages of design memory"
length
site-documents*site*
:a:class
if
equalkind"work"
"door selected""door"
:href
href"work.html"
:span.door-title"Work"
:span.door-meta"work marks by status"
when
site-source-files*site*
:a:class
if
memberkind'
"source""source-file"
:test#'equal
"door selected""door"
:href
href"source.html"
:span.door-title"Source"
:span.door-meta
formatnil"~D systems, ~D files"
length
site-systems*site*
length
site-source-files*site*
:div.status
:span.status-left
:span.status-right
cond
*rendering-document*
:a:href
concatenate'string
site-source-url*site*
"wiki/"".org"
concatenate'string".org"
functionpright
funcallright
tright
:main
funcallbody
:footer.site-footer"Rendered from Org and Lisp by luv.wiki."
defvar*page-definition-cards*nil

While a page renders: a hash table from definition to its card id, filled by every definition link drawn on the page.

defundefinition-card-id

Register definition for a card on the current page and return the id.

defundefinition-docstring

The documentation string of definition's form as plain text, or NIL: the first string among the arguments after the head, or the value after :documentation.

let
children
element-children
definition-nodedefinition
previousnil
flet
documentation-keyword-p
and
equal
lisp-symbol-packagenode
"KEYWORD"
string-equal
lisp-symbol-namenode
"documentation"
dolist
child
cddrchildren
cond
and
typepchild'lisp-string
or
documentation-keyword-pprevious
find#\Newline
node-textchild
not
typepprevious'lisp-list

(:documentation "...") as a DEFCLASS or DEFGENERIC option.

and
typepchild'lisp-list
documentation-keyword-p
first
element-childrenchild
typep
second
element-childrenchild
'lisp-string
return
string-node-content
second
element-childrenchild
unless
typepchild'lisp-comment
setfpreviouschild
defundefinition-lambda-list-text

The lambda list of definition as written in the source, or NIL.

let
children
element-children
definition-nodedefinition
when
member
definition-kinddefinition
'
"defun""defmacro""defgeneric""defmethod""define-command""deftype"
:test#'string=
let
list
find-if
lambda
c
typepc'lisp-list
cddrchildren
andlist
node-textlist
defunrender-definition-cards

Emit hidden cards for the definitions linked on this page.

when
spinneret:with-html
:div.figure-cards:hiddent
maphash
lambda
:div.figure-card:idid
:a.card-title:href
:span.card-kind
definition-kinddefinition
" "
definition-namedefinition
dolist
qualifier
definition-qualifiersdefinition
spinneret:html" "
:span.qualifierqualifier
let
whenlambda-list
:code.card-lambda-listlambda-list
:span.card-meta
formatnil"~A:~D"
definition-linedefinition
when
definition-packagedefinition
spinneret:html" · "
:span
string-trim"#:\""
definition-packagedefinition
let
whendocstring
:p.card-excerpt
let
text
substitute#\Space#\Newlinedocstring
if
>
lengthtext
320
concatenate'string
subseqtext0
or
position#\Spacetext:from-endt:end320
320
"…"
text
*page-definition-cards*
defunfigure-excerpt
figure&optional
limit320

The opening prose of figure's own section as plain text: paragraphs and list items in order until about limit characters, cut at a word boundary.

let
pieces'
flet
add
text
pushtextpieces
incflength
lengthtext
blockcollect
dolist
child
element-childrenfigure
typecasechild
paragraph
add
inline-text
element-childrenchild
plain-list
dolist
item
element-childrenchild
let
paragraph
find-if
lambda
c
typepc'paragraph
element-childrenitem
whenparagraph
add
concatenate'string"– "
inline-text
element-childrenparagraph
heading
return-fromcollect
when
>lengthlimit
return-fromcollect
let
text
formatnil"~{~A~^ ~}"
nreversepieces
cond
zerop
lengthtext
nil
<=
lengthtext
limit
text
t
let
cut
or
position#\Spacetext:from-endt:endlimit
limit
concatenate'string
subseqtext0cut
"…"
defunrender-figure-cards

Emit hidden cards for the figures ids, which the page's script shows as popovers when a mention is hovered or tapped.

let
figures
removenil
mapcar
lambda
id
remove-duplicatesids:test#'equal
whenfigures
spinneret:with-html
:div.figure-cards:hiddent
dolist
figurefigures
let
:div.figure-card:id
concatenate'string"card-"id
:span.card-meta
concatenate'string
document-namedocument
".org"
spinneret:html" · "
:span.card-id
concatenate'string"#"id
let
whenexcerpt
:p.card-excerptexcerpt
defunrender-page

Emit the whole HTML page for document.

let
render-page-frametitle
lambda
spinneret:with-html
:h1title
dolist
child
element-childrendocument
render-figure-cards
append

Code references shown on this page mention figures too.

loopforfigureinappend
loopfordefinitionin
gethash
site-code-references*site*
append
definition-mentionsdefinition
:crumbs
if
string=
document-namedocument
"index"
list
constitlenil
list
cons"Pages""pages.html"
constitlenil
defunrender-pages-page

Emit pages.html: every wiki page with its headings, each a link to its figure, work marks flagged; a dense table.

let
render-page-frame"Pages"
lambda
spinneret:with-html
:h1"Pages"
:p.lede

Every page of the wiki with its headings. Each heading is a figure with a stable ID; work marks carry their status.

:table.pages
:tbody
dolist
document
site-documentssite
:tr
:td.page-headings
dolist
:a:class
formatnil"heading level-~D~@[ marked~]"
heading-levelfigure
heading-keywordfigure
:href
:body-class"wide"
defparameter*work-statuses*'
"NEXT"."the current best small bets"
"TODO"."visible and likely, not yet selected"
"WAIT"."blocked on outside evidence or another step"
"IDEA"."tempting, not allowed to steer implementation yet"
"DONE"."closed, with the evidence that closed them"
defunrender-work-page

Emit work.html: the work marks by status, each with its page and intent.

let
dolist
document
site-documentssite
setfmarks
nreversemarks
render-page-frame"Work"
lambda
spinneret:with-html
:h1"Work"
:p.lede

The work marks of the wiki: figures whose title starts with a status word. They live beside the design they move; this is only a view.

loopfor
status.meaning
in*work-statuses*forthese=
removestatusmarks:key#'heading-keyword:test-not#'string=
whenthesedo
:section.work-status
:h2
:span:class
formatnil"mark mark-~(~A~)"status
status
" "
:span.status-meaningmeaning
:table.work
:tbody
dolist
markthese
:tr
:td.work-title
:a:href
render-inlines
heading-titlemark
:span.work-page
document-name
heading-documentmark
:td.work-intent
let
excerpt
whenexcerptexcerpt
:body-class"wide"
defuncall-with-html-output
streamthunk

Call thunk with Spinneret writing exact, compact HTML to stream. The pretty printer would fill text and insert spaces between dynamically written strings, turning *figure* into "figure "; the wiki's text carries its own spacing, so both are turned off.

let
spinneret:*html*stream
spinneret:*suppress-inserted-spaces*t
*print-pretty*nil
funcallthunk
defunrender-document-string

Render document to an HTML string within site.

let
with-output-to-string
out
defunwrite-html-file
pathnamethunk
ensure-directories-existpathname
with-open-file
outpathname:direction:output:if-exists:supersede:external-format:utf-8
pathname
defunwrite-stylesheet
directory

Compile the style definitions and write them as style.css in directory.

let
pathname
merge-pathnames"style.css"directory
ensure-directories-existpathname
with-open-file
outpathname:direction:output:if-exists:supersede:external-format:utf-8
pathname
defunwrite-site
sitedirectory&key
stylesheett

Write every page of site, the figures index, and, unless stylesheet is NIL, the compiled stylesheet into directory.

let
directory
uiop:ensure-directory-pathnamedirectory
dolist
document
site-documentssite
write-html-file
merge-pathnames"pages.html"directory
write-html-file
merge-pathnames"work.html"directory
when
site-source-filessite
write-html-file
merge-pathnames"source.html"directory
dolist
file
site-source-filessite
write-html-file
merge-pathnamesdirectory
whenstylesheet
directory