luv

Workshop wiki

dexp.lisp

wiki/dexp.lisp

system luv-wiki · 110 definitions · on GitHub

Rendering Lisp source as dexp boxes.

After wisp's structure editor: every list is a flex-wrapping box whose left and right borders are its parentheses; atoms are inline spans. Forms flow horizontally while they fit and wrap when they do not, so the layout is responsive without any line-breaking logic. The only structural knowledge is a small table of operator roles: which leading children are the head and which are body forms that should take the full width and stack. Roles are assigned here, in Lisp; the stylesheet needs only `.lisp .body { flex-basis: 100% }`.

in-package#:luv.wiki
defvar*lisp-role*nil"The layout role of the node being rendered: \"operator\", \"body\", or NIL."
defvar*lisp-package*nil"The package prefix considered current while rendering, hidden on symbols."
defuncurrent-package-name

The current package as a plain uppercase name, for operator lookups.

and*lisp-package*
string-upcase
string-trim"#:\""*lisp-package*
defvar*docstring-p*nil"True while rendering a string in documentation position."
defvar*prose-parameters*'

Symbol names of the lambda list of the form whose docstring is being rendered; an uppercase word naming one is a parameter reference.

Layouts

A list is drawn according to a layout object. The layout is chosen by the list's operator and by the role its parent gave it: a LET chooses a bindings-layout for itself, and the child it marks as \"bindings\" is drawn by a grid-layout no matter what its first element is. Each layout answers child-role for the children and render-layout for the whole; the stylesheet only knows the roles.

defclasslayout
:documentation

How the children of a list are arranged.

defclassflow-layout
:documentation

The default: children flow and wrap; the first symbol is the operator.

defclassbody-layout
head-count:initarg:head-count:initform0:accessorlayout-head-count:documentation

How many arguments after the operator are the head; the rest are body forms that take the full width.

:documentation

Head arguments inline, then body forms stacked.

defclassbindings-layout
bindings-index:initarg:bindings-index:initform1:accessorlayout-bindings-index:documentation

The index of the argument that is a list of bindings, drawn as a two-column grid.

:documentation

A binding form: LET, FLET, DEFCLASS, DO.

defclassvariables-layout
:documentation

MULTIPLE-VALUE-BIND and friends: the first argument is a list of variables drawn like a lambda list.

defclassspec-layout
:documentation

DOLIST, WITH-OPEN-FILE: the first argument is one (var form ...) clause, not a list of bindings.

defclasslambda-layout
:documentation

A defining or lambda form whose head ends with a lambda list: the lambda list's sublists are (var default) clauses.

defclassmethod-layout
:documentation

DEFMETHOD: the head runs through qualifiers to the lambda list.

defclassclauses-layout
clause-head-count:initarg:clause-head-count:initform1:accessorlayout-clause-head-count:documentation

How many leading elements of each clause are its key: one for COND and CASE, two for HANDLER-CASE, whose clauses name a type and then a lambda list.

:documentation

COND, CASE, HANDLER-CASE: body forms are clauses whose first element is a key or test, not an operator, and whose rest stacks; drawn as a table of key and rest.

defclassgrid-layout
:documentation

A list of bindings or slots: each element a clause, aligned in two columns, name and rest.

defclassclause-layout
:documentation

A binding or slot: a name and the rest, no operator.

defclassstacked-clause-layout
head-count:initarg:head-count:initform1:accessorlayout-head-count
lambda-list-index:initarg:lambda-list-index:initformnil:accessorlayout-lambda-list-index:documentation

The index of a lambda list among the head elements, as in a HANDLER-CASE clause, or NIL.

:documentation

A COND-style clause: a key or test, then body forms stacked.

defclasslambda-list-layout
:documentation

A lambda list: parameters flow; (var default) sublists are clauses, not calls.

defclassloop-layout
:documentation

LOOP: its clause keywords start new rows.

defclasspairs-layout
:documentation

SETF, SETQ, PSETF: the arguments are place value pairs; with more than one pair each is a row of a two-column table.

defvar*operator-layouts*
make-hash-table:test'equal
"Downcased operator name -> LAYOUT instance."
defmacrodefine-layout
namesclass&restinitargs

Give each operator in names (strings) a fresh class layout.

`
dolist
name',
if
listpnames
names
listnames
setf
make-instance',class,@initargs
define-layout
"defun""defmacro""defgeneric""deftype""define-modify-macro"
lambda-layout
:head-count2
define-layout
"lambda"
lambda-layout
:head-count1
define-layout
"let""let*""flet""labels""macrolet""symbol-macrolet""handler-bind"
bindings-layout
:head-count1:bindings-index1
define-layout
"multiple-value-bind""destructuring-bind""with-slots""with-accessors"
variables-layout
:head-count2
define-layout
"dolist""dotimes""with-open-file""with-output-to-string""with-input-from-string""with-open-stream""with-simple-restart"
spec-layout
:head-count1
define-layout
"do""do*"
bindings-layout
:head-count2:bindings-index1
define-layout
"defclass""define-condition"
bindings-layout
:head-count3:bindings-index3
define-layout
"case""ecase""ccase""typecase""etypecase""ctypecase"
clauses-layout
:head-count1
define-layout
"handler-case""restart-case"
clauses-layout
:head-count1:clause-head-count2
define-layout
"cond"
clauses-layout
:head-count0
define-layout
"defstruct""defpackage"
clauses-layout
:head-count1
define-layout
"defvar""defparameter""defconstant""declaim""declare""block""prog1""when""unless""if""unwind-protect""eval-when"
body-layout
:head-count1
define-layout
"progn"
body-layout
:head-count0
define-layout
"setf""setq""psetf""psetq"
pairs-layout
defparameter*loop-keywords*'
"named""with""for""as""initially""finally""repeat""while""until""always""never""thereis""do""doing""collect""collecting""append""appending""nconc""nconcing""count""counting""sum""summing""maximize""maximizing""minimize""minimizing""when""if""unless""else""end""return"
defunoperator-layout
namelist

The layout for operator name of list, from the table or, for operators that only follow a naming convention, by inspecting the form: a WITH- form has one head argument; a DEF form whose second argument is a list is a lambda form; any other DEF form is a name followed by options.

let*
name
string-downcasename
arguments
head
firstarguments
facts
operator-factsname
or
and
typephead'lisp-symbol
stringp
lisp-symbol-packagehead
lisp-symbol-packagehead
or
andfacts
cond
starts-with"with-"name
make-instance'body-layout:head-count1
and
starts-with"def"name
typep
thirdarguments
'lisp-list
make-instance'lambda-layout:head-count2
starts-with"def"name
make-instance'body-layout:head-count1
t
make-instance'flow-layout
defgenericlist-layout
listrole
:documentation

The layout for list given the role its parent assigned.

:method
role
cond
and
role-prole"bindings"
some
lambda
c
typepc'lisp-list
element-childrenlist
make-instance'grid-layout
role-prole"bindings"
make-instance'lambda-list-layout
role-prole"lambda-list"
make-instance'lambda-list-layout
role-prole"clause"
make-instance'clause-layout
role-prole"handler-clause"
make-instance'stacked-clause-layout:head-count2:lambda-list-index1
role-prole"stacked-clause"
make-instance'stacked-clause-layout
t
let
operator
symbol-node-name
first
element-childrenlist
ifoperator
operator-layoutoperatorlist
make-instance'flow-layout
defunrole-p
rolename
androle
membername
uiop:split-stringrole
:test#'string=
defunargument-children
list

The children of list that count as arguments: everything but comments.

remove-if
lambda
c
element-childrenlist
defgenericchild-role
layoutlistindexchild
:documentation

The role string for child, the INDEXth argument of list under layout (comments are not counted and never asked), or NIL.

:method
listindexchild
declare
ignorelist
and
=index0
typepchild'lisp-symbol
"operator"
defmethodchild-role
listindexchild
cond
>index
layout-head-countlayout
"body"
t
call-next-method
defmethodchild-role
listindexchild
cond
and
=index
layout-bindings-indexlayout
typepchild'lisp-list
"bindings"
t
call-next-method
defmethodchild-role
cond
and
=index1
typepchild'lisp-list
"lambda-list"
t
call-next-method
defmethodchild-role
listindexchild
cond
and
=index1
typepchild'lisp-list
"clause"
t
call-next-method
defmethodchild-role
listindexchild
cond
and
<=index
layout-head-countlayout
typepchild'lisp-list
"lambda-list"
t
call-next-method
defmethodchild-role
declare
ignorelistindex
and
typepchild'lisp-list
"clause"
defmethodchild-role
listindexchild

Qualifiers precede the lambda list; the first list after the name is it.

let*
arguments
lambda-list
position-if
lambda
c
typepc'lisp-list
arguments:start2
cond
andlambda-list
=indexlambda-list
"lambda-list"
andlambda-list
>indexlambda-list
"body"
=index0
"operator"
tnil
defmethodchild-role
listindexchild
cond
and
>index
layout-head-countlayout
typepchild'lisp-list
if
>
layout-clause-head-countlayout
1
"body stacked-clause handler-clause""body stacked-clause"
t
call-next-method
defmethodchild-role
listindexchild
declare
ignorelistindex
and
typepchild'lisp-list
"clause"
defmethodchild-role
listindexchild
declare
ignorelistindexchild
nil
defmethodchild-role
declare
ignorelist
cond
>=index
layout-head-countlayout
"body"
and
eqlindex
layout-lambda-list-indexlayout
typepchild'lisp-list
"lambda-list"
tnil
defmethodchild-role
listindexchild

Values are body forms when there is more than one pair, so the pairs stack as rows; a single pair stays inline.

declare
ignorechild
cond
=index0
"operator"
"body"
tnil
defmethodchild-role
listindexchild
declare
ignorelist
cond
=index0
"operator"
and
typepchild'lisp-symbol
null
lisp-symbol-packagechild
member
string-downcase
lisp-symbol-namechild
*loop-keywords*:test#'string=
"row-start"
tnil

Layouts derived from real lambda lists (see introspect.lisp)

defvar*arglists*
make-hash-table:test'equal

(PACKAGE . NAME) -> facts plist gathered by scripts/wiki introspect, and NAME -> facts for lookup without a package.

defunload-arglists
pathname

Read the operator facts written by write-arglists into *ARGLISTS*.

clrhash*arglists*
when
probe-filepathname
with-open-file
inpathname
with-standard-io-syntax
let
*package*
find-package:cl-user
*read-eval*nil
loopforentry=
readinnilnil
whileentrydo
destructuring-bind
package.name
&restfacts
entry
setf
gethash
conspackagename
*arglists*
facts
unless
gethashname*arglists*
setf
gethashname*arglists*
facts
hash-table-count*arglists*
defunoperator-facts
namepackage

The introspected facts for operator name in package (a name or NIL).

let
name
string-upcasename
or
andpackage
gethash
cons
string-upcasepackage
name
*arglists*
gethashname*arglists*
defclassderived-layout
kind:initarg:kind:accessorlayout-kind
name:initarg:name:initformnil:accessorlayout-name
head-count:initarg:head-count:initform0:accessorlayout-head-count
body-p:initarg:body-p:initformnil:accessorlayout-body-p
pairs-start:initarg:pairs-start:initformnil:accessorlayout-pairs-start:documentation"Argument index where &KEY pairs begin, or NIL."
roles:initarg:roles:initform'
:accessorlayout-roles:documentation

Alist of (argument-index . role) from the lambda list: a destructuring pattern is a clause, a parameter named BINDINGS or SLOTS a binding grid, one named LAMBDA-LIST a lambda list.

body-role:initarg:body-role:initform"body":accessorlayout-body-role
:documentation

A layout computed from an operator's real lambda list.

defunparameter-role
parameter

The role a parameter's name or shape suggests for the argument in its position: a destructuring pattern is a clause; a name that says BINDINGS or SLOTS is a binding grid; LAMBDA-LIST is a lambda list.

cond
conspparameter
"clause"
stringpparameter
cond
search"LAMBDA-LIST"parameter
"lambda-list"
search"ARGLIST"parameter
"lambda-list"
memberparameter'
"ARGS""VARS""VARIABLES""PARAMETERS"
:test#'string=
"lambda-list"
search"BINDING"parameter
"bindings"
search"DEFINITIONS"parameter
"bindings"
search"SLOT"parameter
"bindings"
tnil
tnil
defunarglist-layout
facts&optionalname

Derive a layout from facts, walking the lambda list at its base level.

let
kind
getffacts:kind
lambda-list
getffacts:lambda-list
index0
roles'
body-pnil
pairs-startnil
body-role"body"
state:required
loopwithrest=lambda-listwhilerestdo
let
parameter
poprest
caseparameter
:&whole:&environment
poprest
:&optional
setfstate:optional
:&aux
:&key
setfpairs-start
1+index
:&rest:&body
let
name
poprest
when
or
eqparameter:&body
memberkind'
:macro:special-operator
setfbody-p
or
eqparameter:&body
memberkind'
:macro:special-operator
when
and
stringpname
or
search"CLAUSE"name
search"CASE"name
search"SLOT"name
setfbody-role"body stacked-clause"

Anything after &rest/&body except &key does not count.

loopwhile
andrest
not
eq
firstrest
:&key
do
poprest
when
eq
firstrest
:&key
setfpairs-start
1+index
t
incfindex
let
role
parameter-role
if
and
eqstate:optional
conspparameter
firstparameter
parameter
whenrole
push
consindexrole
roles
make-instance'derived-layout:kindkind:namename:head-countindex:body-p
andbody-pt
:pairs-startpairs-start:roles
nreverseroles
:body-rolebody-role
defmethodchild-role
listindexchild
let
entry
associndex
layout-roleslayout
cond
andentry
typepchild'lisp-list
cdrentry

The keyword options of a defining macro stack as rows.

and
layout-pairs-startlayout
>=index
layout-pairs-startlayout
eq
layout-kindlayout
:macro
layout-namelayout
starts-with"def"
layout-namelayout
"body"
and
layout-body-playout
>index
layout-head-countlayout
or
null
layout-pairs-startlayout
<index
layout-pairs-startlayout
if
typepchild'lisp-list
layout-body-rolelayout
"body"
=index0
and
typepchild'lisp-symbol
"operator"
tnil
defgenericlayout-pairs-index
layoutarguments
:documentation

The argument index where key value pairs begin under layout, or NIL; the default guesses a trailing run of :keyword value pairs from the arguments themselves.

:method
arguments
:methodnil
:methodnil
:methodnil
:method1
:method
or
layout-pairs-startlayout
call-next-method
defunlambda-list-of
layoutlist

The lambda list of list under layout, if the layout has one.

typecaselayout
method-layout
find-if
lambda
c
typepc'lisp-list
lambda-layout
let
head
subseq1
min
1+
layout-head-countlayout
find-if
lambda
c
typepc'lisp-list
head:from-endt
tnil
defundocstring-position-p
layoutlistindexpreviouschild

True when child is a string in documentation position: the first body form of a defining form, or the value after :documentation.

and
typepchild'lisp-string
or
and
=index
1+
layout-head-countlayout
defining-operator-p
or
symbol-node-name
first
element-childrenlist
""
and
equal
child-rolelayoutlistindexchild
"body"
let
before
nth
1-index
typepbefore'lisp-list
and
typepprevious'lisp-symbol
equal
lisp-symbol-packageprevious
"KEYWORD"
string-equal
lisp-symbol-nameprevious
"documentation"
defgenericrender-layout
layoutlist
:documentation

Emit the children of list arranged by layout, inside the list's own box, which the caller has opened.

defunkeyword-symbol-p
and
equal
lisp-symbol-packagenode
"KEYWORD"
defunkeyword-pairs-start
arguments

The index in arguments from which the rest is :keyword value pairs, or NIL. The tail must have even length and a keyword at every even offset; the earliest such start after the operator wins.

let
n
lengtharguments
loopforstartfrom1belownwhen
and
evenp
-nstart
loopforifromstartbelownby2always
keyword-symbol-p
nthiarguments
returnstart

Drawing

The children of a list are first grouped into ITEMs -- a comment, one child with its role, or a :keyword value pair -- and then drawn. A list with body items is stacked: its head items go in a .head row and each body item is a row of its own, so the box is a grid of rows and hugs its widest row instead of stretching to the parent (#993QQQ).

defstruct
item
:constructormake-item
kindrolenode&keyvaluecommentsindexprevious

One drawn unit of a list: KIND is :comment, :child, or :pair. ROLE is the role the layout gave it (a pair takes its value's role); node the child or the key; VALUE and COMMENTS the pair's value and the comments between key and value; INDEX and PREVIOUS the argument index and previous argument, for docstring position.

kindrolenodevaluecommentsindexprevious
defunitem-body-p
item
role-p
item-roleitem
"body"
defunlayout-items
layoutlist

The children of list grouped for drawing under layout. Comments are kept where they occur and are not counted. A trailing run of :keyword value pairs is grouped pair by pair, keeping the key with its value.

let*
arguments
pairs-start
index-1
previousnil
remaining
element-childrenlist
items'
loopwhileremainingdo
let
child
popremaining
cond
typepchild'lisp-comment
push
make-item:commentnilchild
items
t
incfindex
let
role
child-rolelayoutlistindexchild
if
andpairs-start
>=indexpairs-start
evenp
-indexpairs-start
find-if-not
lambda
c
remaining

A key: group it with its value.

let
comments'
valuenil
loopforc=
popremaining
do
if
pushccomments
progn
setfvaluec
incfindex
push
make-item:pair
child-rolelayoutlistindexvalue
child:valuevalue:comments
nreversecomments
:indexindex:previousprevious
items
setfpreviousvalue
progn
push
make-item:childrolechild:indexindex:previousprevious
items
setfpreviouschild
nreverseitems
defunrender-item
layoutlistitem

Draw item of list under layout.

flet
emit
childroleindexprevious
ecase
item-kinditem
:comment
let
render-html
item-nodeitem
:child
when
and
role-p
item-roleitem
"row-start"
>
item-indexitem
1
spinneret:with-html
:span.break
emit
item-nodeitem
item-roleitem
item-indexitem
item-previousitem
:pair
spinneret:with-html
:span:class
let
*lisp-role*
item-roleitem
emit
item-nodeitem
nil
1-
item-indexitem
item-previousitem
dolist
c
item-commentsitem
emit
item-valueitem
nil
item-indexitem
item-nodeitem
defunsplit-head-items
items

items before the first body item as the head, and the rest as rows; comments just before the first body item are rows, not head.

let
position
position-if#'item-body-pitems
if
valuesitems'
progn
loopwhile
and
eq
item-kind
nthitems
:comment
do
values
subseqitems0position
nthcdrpositionitems
defunrender-children-with-roles
layoutlist

Emit every child of list with the role layout assigns it. When some child is a body form the list is stacked: the head children go in a .head span and every body form is a row.

let
if
some#'item-body-pitems
multiple-value-bind
headrows
spinneret:with-html
:span.head
dolist
itemhead
dolist
itemrows
dolist
itemitems
defgenericlayout-classes
layoutlist
:documentation

Extra CSS classes for the box of list under layout.

:method
:method
list*"clauses"
call-next-method
:method
let
classes
call-next-method
ifclasses
list*"pairs"classes
classes
:method
declare
ignorelist
'
:method
declare
ignorelist
'
defmethodrender-layout

A clause: its first element in the name column, the rest in one flowing cell, so the parent's grid can align them.

let
children
element-childrenlist
let
whenchildren
render-html
firstchildren
when
restchildren
spinneret:with-html
:span.rest
let
dolist
child
restchildren
defmethodrender-layout

A COND-style clause, one row of its parent's clause table (#4175NC): the key or test in a .head cell, then the body forms stacked in a .rest cell.

let
multiple-value-bind
headrows
spinneret:with-html
:span.head
dolist
itemhead
whenrows
:span.rest
dolist
itemrows
defunrender-text-with-mentions
text

Write text, turning #ID figure mentions into links like prose does.

let
start0
loopforifrom0below
lengthtext
do
when
char=
chartexti
#\#
let
end
whenend
spinneret:html
subseqtextstarti
render-html
make-instance'mention:id
subseqtext
1+i
end
setfstartend
spinneret:html
subseqtextstart
defunrole-class
&restclasses
formatnil"~{~A~^ ~}"
removenil
cons*lisp-role*classes
defgenericlayout-callee-p
:documentation

True when the first symbol of a list under layout names an operator, worth a data-callee attribute; false for clauses, binding grids, and lambda lists, whose first element is data.

:methodt
defmethodrender-html
let*
spinneret:with-html
:div:class:data-callee
andoperator
string-downcaseoperator
defmethodrender-html
spinneret:with-html
:div:class
role-class"list""vector"
render-layout
make-instance'flow-layout
vector
defmethodrender-html
let*
package
lisp-symbol-packagesymbol
name
lisp-symbol-namesymbol
keyword-p
equalpackage"KEYWORD"
current-p
or
nullpackage
and
stringppackage
*lisp-package*
string-equalpackage*lisp-package*
spinneret:with-html
:span:class
role-class"symbol"
andkeyword-p"keyword"
:data-symbol-namename
let*
ifhref
:a.definition-link:hrefhref:data-card
render-symbol-textsymbolpackagecurrent-pkeyword-p
render-symbol-textsymbolpackagecurrent-pkeyword-p
defunrender-symbol-text
symbolpackagecurrent-pkeyword-p

The package prefix, if shown, and the name of symbol.

spinneret:with-html
cond
keyword-p
:span.package":"
eqpackage:uninterned
:span.package"#:"
notcurrent-p
:span.package
string-downcasepackage
if
lisp-symbol-external-psymbol
":""::"
:span.name
string-downcase
lisp-symbol-namesymbol
defmethodrender-html
spinneret:with-html
:span:class
node-textatom
defclasssymbol-reference
name:initarg:name:accessorsymbol-reference-name
:documentation

An uppercase word in code prose that names a symbol: a parameter of the enclosing form or a definition in the corpus.

defunsymbol-word-p
word

True when word is written the way docstrings write symbols: at least two characters, all uppercase letters, digits, or symbol punctuation, with at least one letter.

and
some#'alpha-char-pword
every
lambda
c
or
upper-case-pc
digit-char-pc
memberc'
#\-#\*#\+#\%#\/#\<#\>#\=#\!
word
defunsymbol-reference-p
word

An uppercase word is a symbol reference when it names a parameter of the enclosing form, a definition in the corpus, or is a *special* name.

and
or
memberword*prose-parameters*:test#'string-equal
and*site*
gethash
site-definition-table*site*
and
>
lengthword
2
char=
charword0
#\*
char=
charword
1-
lengthword
#\*
defunmark-symbol-references
inlines

Split the strings among inlines so that symbol words become symbol-reference objects.

loopforinlineininlinesappend
if
stringpinline
progn
when
typepinline'
unless
and
typepinline'emphasis
member
emphasis-kindinline
'
:verbatim:code
setf
element-childreninline
mark-symbol-references
element-childreninline
listinline
defunsplit-symbol-references
string
let
result'
start0
i0
n
lengthstring
flet
word-char-p
c
or
alphanumericpc
memberc'
#\-#\*#\+#\%#\/#\<#\>#\=#\!
loopwhile
<in
do
if
word-char-p
charstringi
let
end
or
position-if-not#'word-char-pstring:starti
n
let
word
subseqstringiend
when
when
>istart
push
subseqstringstarti
result
push
make-instance'symbol-reference:nameword
result
setfstartend
setfiend
incfi
when
<startn
push
subseqstringstart
result
nreverseresult
defmethodrender-html

Drawn like a symbol in the boxes: lowercase code, linked to its definition when the corpus has one.

let*
spinneret:with-html
ifhref
:a.definition-link:hrefhref:data-card
:code.symbol
string-downcasename
:code.symbol
string-downcasename
defunmark-prose-references

Turn symbol words in the paragraphs of element into references.

map-elements
lambda
e
when
typepe'paragraph
setf
element-childrene
mark-symbol-references
element-childrene
element
defunrender-code-prose
text

Render text, the content of a docstring or comment, as wiki prose: paragraphs, lists, and inline markup, with #ID mentions as links and uppercase symbol words as symbol references.

let
dolist
block
read-blocks
coerce
uiop:split-stringtext:separator'
#\Newline
'vector
defunlambda-list-parameters
list

The parameter names in the lambda list list (a lisp-list), including those inside specializer or default forms and skipping &keywords.

let
names'
labels
walk
typecasenode
lisp-symbol
let
name
lisp-symbol-namenode
unless
char=
charname0
#\&
pushnewnamenames:test#'string=
lisp-list
let
first
first
element-childrennode

(var default) or (var specializer): only the first

when
typepfirst'lisp-symbol
pushnew
lisp-symbol-namefirst
names:test#'string=
mapc#'walk
element-childrenlist
names
defunstring-node-content
string

The characters of a string literal string, without the quotes and with \" and \\ escapes undone.

let
text
node-textstring
with-output-to-string
out
loopwithi=1while
<i
1-
lengthtext
do
let
c
chartexti
if
and
char=c#\\
<
1+i
1-
lengthtext
progn
write-char
chartext
1+i
out
incfi2
progn
write-charcout
incfi
defundedent
text

Remove the indentation common to every non-blank line after the first.

let*
lines
uiop:split-stringtext:separator'
#\Newline
rest
remove-if#'blank-line-p
restlines
indent
ifrest
reduce#'min
mapcar#'indentationrest
0
formatnil"~{~A~^~%~}"
cons
firstlines
mapcar
lambda
line
subseqline
minindent
lengthline
restlines
defmethodrender-html
let
text
node-textstring
spinneret:with-html
if
or*docstring-p*
find#\Newlinetext

Documentation, or any multi-line string, is rendered as prose.

defuncomment-content
comment

The text of comment without its ; prefixes or #| |# delimiters.

let
text
node-textcomment
if
starts-with"#|"text
string-trim'
#\Space#\Newline
subseqtext2
max2
-
lengthtext
if
ends-with"|#"text
20
formatnil"~{~A~^~%~}"
mapcar
lambda
line
let*
line
string-left-trim'
#\Space#\Tab
line
semis
or
position-if-not
lambda
c
char=c#\;
line
lengthline
string-left-trim'
#\Space
subseqlinesemis
uiop:split-stringtext:separator'
#\Newline
defunends-with
suffixstring
and
>=
lengthstring
lengthsuffix
string=suffixstring:start2
-
lengthstring
lengthsuffix
defmethodrender-html
spinneret:with-html
:span:class
role-class"number"
node-textnumber
defmethodrender-html
spinneret:with-html
:span:class
role-class"character"
node-textcharacter
defmethodrender-html
spinneret:with-html
:span:class
role-class"prefixed"
:span.prefix
lisp-prefix-stringprefix
let
render-html
lisp-prefix-childprefix
defmethodrender-html
conditionallisp-conditional
spinneret:with-html
:span:class
role-class"conditional"
:span.prefix
lisp-conditional-signconditional
let
when
lisp-conditional-featureconditional
render-html
lisp-conditional-featureconditional
if
lisp-conditional-formconditional
render-html
lisp-conditional-formconditional

The skipped branch is shown as its text.

:span.skipped
string-left-trim" "
subseq
node-textconditional
if
lisp-conditional-featureconditional
-
node-end
lisp-conditional-featureconditional
node-startconditional
2
defmethodrender-html
spinneret:with-html
:div:class
role-class"comment""prose"
defmethodrender-html
spinneret:with-html
:span:class
role-class"skipped"
node-textskipped
defunrender-lisp-nodes
nodes&keypackage

Emit a .lisp container holding nodes rendered as dexp boxes.

let
spinneret:with-html
:div.lisp
defunrender-lisp-source
text&keypackage

Read text and render it structurally; on any failure fall back to a plain <pre>, so a page never loses its code.

let
nodes
handler-case
error
condition
warn"Rendering Lisp source as text: ~A"condition
nil
ifnodes
render-lisp-nodesnodes:packagepackage
spinneret:with-html
:pre.src:data-language"lisp"
:codetext