luv

Workshop wiki

org.lisp

wiki/org.lisp

system luv-wiki · 58 definitions · on GitHub

An Org-subset reader for the luv wiki.

The wiki pages are Org files, but they use a deliberately small and regular subset: a title keyword, headings with property drawers, paragraphs, plain and ordered lists, example and source blocks, simple tables, bracket links, the light #XYZ123 figure mention, and the six inline emphasis markers. This reader turns that subset into a tree of CLOS elements. It is not a general Org parser and does not try to be: anything it does not recognize is kept as paragraph text, so a page can never fail to build because of an unfamiliar construct.

in-package#:luv.wiki

Element model

defclasselement
children:initarg:children:initform'
:accessorelement-children
:documentation

A block-level piece of an Org document.

defclassdocument
pathname:initarg:pathname:initformnil:accessordocument-pathname
name:initarg:name:initformnil:accessordocument-name:documentation"The page name, normally the file name without type."
keywords:initarg:keywords:initform'
:accessordocument-keywords:documentation"An alist of (\"title\" . \"value\") file keywords."
:documentation

One wiki page: file keywords and a tree of headings.

defclassheading
level:initarg:level:accessorheading-level
title:initarg:title:accessorheading-title:documentation"The heading title as a list of inline objects."
keyword:initarg:keyword:initformnil:accessorheading-keyword:documentation"A work-mark status word such as NEXT, or NIL."
properties:initarg:properties:initform'
:accessorheading-properties
document:initarg:document:initformnil:accessorheading-document
:documentation

An Org headline with its section and subheadings.

defclassparagraph
:documentation

A run of prose; CHILDREN are inline objects.

defclassplain-list
ordered-p:initarg:ordered-p:initformnil:accessorplain-list-ordered-p
:documentation

A bulleted or numbered list of LIST-ITEMs.

defclasslist-item
:documentation

One list item; CHILDREN are blocks, usually a paragraph.

defclassexample-block
text:initarg:text:accessorblock-text
:documentation

A #+begin_example block, kept verbatim.

defclasssrc-block
language:initarg:language:initformnil:accessorsrc-block-language
:documentation

A #+begin_src block with its language.

defclasstable
rows:initarg:rows:accessortable-rows:documentation"A list of rows; each row is a list of inline lists."
header-p:initarg:header-p:initformnil:accessortable-header-p:documentation"True when the first row is separated by a rule."
:documentation

A simple Org table without formulas.

Inline objects. Plain text is represented by strings.

defclassemphasis
kind:initarg:kind:accessoremphasis-kind:documentation"One of :bold :italic :underline :strike :verbatim :code."
children:initarg:children:initform'
:accessorelement-children
:documentation

Emphasized text; VERBATIM and CODE hold one string child.

defclasslink
protocol:initarg:protocol:initformnil:accessorlink-protocol:documentation"The link scheme as a string, e.g. \"file\", or NIL."
path:initarg:path:accessorlink-path
search:initarg:search:initformnil:accessorlink-search:documentation"The ::search part of a file link, if any."
children:initarg:children:initform'
:accessorelement-children:documentation"The description inlines, or NIL for a bare link."
:documentation

An Org bracket link.

defclassmath
text:initarg:text:accessormath-text:documentation"The TeX source without delimiters."
display-p:initarg:display-p:initformnil:accessormath-display-p
:documentation

Inline ... or ... math, or display

...
and
...
.
defclassmention
id:initarg:id:accessormention-id
:documentation

A light #ID reference to a figure: a hash and six capitals or digits.

defgenericreference-id
inline
:documentation

The figure ID an inline object refers to, or NIL.

:method
inlinet
nil
:method
inlinemention
mention-idinline
:method
inlinelink
when
equal
link-protocolinline
"id"
link-pathinline
defmethodheading-id
cdr
assoc"ID"
heading-propertiesheading
:test#'string-equal
defmethoddocument-title
cdr
assoc"title"
document-keywordsdocument
:test#'string-equal
defmethodprint-object
print-unreadable-object
headingstream:typet
formatstream"~A ~S"
inline-text
heading-titleheading
defmethodprint-object
print-unreadable-object
documentstream:typet
formatstream"~A"
document-namedocument
defunmap-elements

Call function on element and, depth first, on every block-level descendant.

dolist
child
element-childrenelement
when
typepchild'element
defundocument-figures

All headings in document that carry an ID, in document order.

let
figures'
nreversefigures
defuninline-text
inlines

The plain text of a list of inline objects, dropping markup.

with-output-to-string
out
labels
walk
x
etypecasex
string
write-stringxout
mention
formatout"#~A"
mention-idx
math
write-string
math-textx
out
link
if
element-childrenx
mapc#'walk
element-childrenx
write-string
link-pathx
out
emphasis
mapc#'walk
element-childrenx
mapc#'walkinlines

Line utilities

defparameter*work-mark-keywords*'
"NEXT""TODO""WAIT""DONE""IDEA"
"Status words that turn a heading into a work mark; see index.org."
defunblank-line-p
line
every
lambda
c
memberc'
#\Space#\Tab
line
defunindentation
line
or
position-if-not
lambda
c
memberc'
#\Space#\Tab
line
lengthline
defuntrim
string
string-trim'
#\Space#\Tab#\Return
string
defunstarts-with
prefixstring&key
start0
and
<=
+start
lengthprefix
lengthstring
string-equalprefixstring:start2start:end2
+start
lengthprefix
defunkeyword-line-p
line

Return (values name value) when line is a #+name: value keyword line.

when
starts-with"#+"line
let
colon
position#\:line:start2
whencolon
values
subseqline2colon
trim
subseqline
1+colon
defunheading-line-p
line

Return the star count when line is an Org headline.

let
stars
or
position-if-not
lambda
c
char=c#\*
line
lengthline
and
pluspstars
<stars
lengthline
char=
charlinestars
#\Space
stars
defunlist-item-start
line

When line begins a list item, return (values indent ordered-p body-start).

let*
indent
rest
subseqlineindent
cond
and
member
charrest0
'
#\-#\+
char=
charrest1
#\Space
valuesindentnil
+indent2
and
char=
charrest0
#\*
char=
charrest1
#\Space
pluspindent
valuesindentnil
+indent2
t
let
digits
or
position-if-not#'digit-char-prest
lengthrest
when
and
pluspdigits
<
1+digits
lengthrest
member
charrestdigits
'
#\.#\)
char=
charrest
1+digits
#\Space
valuesindentt
+indentdigits2
defunblock-begin-line-p
line

Return (values kind parameters) for a #+begin_KIND line.

let
line
trimline
when
starts-with"#+begin_"line
let*
space
or
position#\Spaceline
lengthline
kind
string-downcase
subseqline8space
parameters
trim
subseqlinespace
valueskindparameters
defunblock-end-line-p
linekind
string-equal
trimline
concatenate'string"#+end_"kind
defuntable-line-p
line
let
line
trimline
and
plusp
lengthline
char=
charline0
#\|

Inline reader

defparameter*emphasis-markers*'
#\*.:bold
#\/.:italic
#\_.:underline
#\+.:strike
#\=.:verbatim
#\~.:code
defunemphasis-pre-char-p
c
or
nullc
memberc'
#\Space#\Tab#\Newline#\-#\(#\{#\'#\"#\[
defunemphasis-post-char-p
c
or
nullc
memberc'
#\Space#\Tab#\Newline#\-#\.#\,#\;#\:#\!#\?#\'#\)#\}#\"#\[#\]
defunchar-before
stringindex
and
pluspindex
charstring
1-index
defunchar-after
stringindex
and
<
1+index
lengthstring
charstring
1+index
defunhex-colour-p
stringstartend

Are the characters of string from start below end all hex digits? A figure ID never is, so that #111517 in a stylesheet stays a colour.

loopforifromstartbelowendalways
digit-char-p
charstringi
16
defunmention-end
stringstart

If a #ID mention (six capitals or digits, not all of them hex digits) begins at start, return the index after it.

let
end
+start7
when
and
<=end
lengthstring
char=
charstringstart
#\#
loopforifrom
1+start
belowendforc=
charstringi
always
or
digit-char-pc
upper-case-pc
not
hex-colour-pstring
1+start
end
not
and
<end
lengthstring
alphanumericp
charstringend
end
defunread-link
stringstart

If a ... link begins at start, return (values link end).

when
starts-with"[["string:startstart
let
close
search"]]"string:start2
+start2
whenclose
let*
inner
subseqstring
+start2
close
sep
search"]["inner
target
ifsep
subseqinner0sep
inner
description
andsep
subseqinner
+sep2
colon
position#\:target
protocol
andcolon
every#'alpha-char-p
subseqtarget0colon
pluspcolon
subseqtarget0colon
path
ifprotocol
subseqtarget
1+colon
target
search
search"::"path
link
make-instance'link:protocolprotocol:path
if
andsearch
equalprotocol"file"
subseqpath0search
path
:search
andsearch
equalprotocol"file"
subseqpath
+search2
:children
anddescription
read-inlinesdescription

The description of a link may not itself contain a link, so a stray "]]" inside it cannot fool us here.

valueslink
+close2
defvar*prose-from-code*nil

True while reading docstrings and comments as prose: there *name* without spaces is a Lisp special variable and reads as code, not bold.

defunread-emphasis
stringstart

If an emphasis span begins at start, return (values emphasis end).

let*
marker
charstringstart
kind
cdr
when
andkind
let
next
char-afterstringstart
andnext
not
membernext'
#\Space#\Tab#\Newline
not
char=nextmarker
loopforendfrom
+start2
below
lengthstring
forc=
charstringend
do
cond
char=c#\Newline

Emphasis may span one line break but not a blank line.

when
and
<
1+end
lengthstring
char=
charstring
1+end
#\Newline
and
char=cmarker
not
member
charstring
1-end
'
#\Space#\Tab#\Newline
let
inner
subseqstring
1+start
end
return
values
if
and*prose-from-code*
eqkind:bold
notany
lambda
c
memberc'
#\Space#\Tab#\Newline
inner
make-instance'emphasis:kind:code:children
list
subseqstringstart
1+end
make-instance'emphasis:kindkind:children
if
memberkind'
:verbatim:code
listinner
1+end
defunread-math
stringstart

If TeX math begins at start, return (values math end). Inline math is ... on one line with no space inside the dollars, or ...; display math is

...
or
...
.
flet
delimited
openclosedisplay-p&key
same-linenil
when
starts-withopenstring:startstart
let*
body-start
+start
lengthopen
end
searchclosestring:start2body-start
when
andend
>endbody-start
or
notsame-line
not
find#\Newlinestring:startbody-start:endend

No space just inside the dollars.

or
not
string=open"$"
and
not
member
charstringbody-start
'
#\Space#\Tab
not
member
charstring
1-end
'
#\Space#\Tab
values
make-instance'math:text
subseqstringbody-startend
:display-pdisplay-p
+end
lengthclose

or would drop the second value; try each form in turn.

loopfor
openclosedisplay-psame-line
in'
"$$""$$"tnil
"\\[""\\]"tnil
"\\(""\\)"nilnil
"$""$"nilt
do
multiple-value-bind
mathend
delimitedopenclosedisplay-p:same-linesame-line
whenmath
return
valuesmathend
defunread-inlines
string

Read string into a list of strings and inline objects.

let
result'
text
make-string-output-stream
i0
n
lengthstring
flet
flush
let
s
get-output-stream-stringtext
when
plusp
pushsresult
emit
objectend
pushobjectresult
setfiend
loopwhile
<in
do
let
c
charstringi
multiple-value-bind
objectend
casec
#\[
read-linkstringi
#\$#\\
read-mathstringi
#\#
let
end
andend
values
make-instance'mention:id
subseqstring
1+i
end
end
cond
object
flush
emitobjectend
t
write-charctext
incfi
flush
nreverseresult

Block reader

The block reader works on a vector of lines and an index. Each reader function takes the lines and a start index and returns (values element next-index), or NIL when the construct does not begin there.

defunread-block-element
linesi
multiple-value-bind
kindparameters
whenkind
let
end
loopforjfrom
1+i
below
lengthlines
when
block-end-line-p
areflinesj
kind
returnj
whenend
let*
body
loopforjfrom
1+i
belowendcollect
areflinesj
indent
reduce#'min
mapcar#'indentation
remove-if#'blank-line-pbody
:initial-valuemost-positive-fixnum
text
formatnil"~{~A~^~%~}"
mapcar
lambda
line
if""
subseqline
minindent
lengthline
body
values
if
string=kind"src"
make-instance'src-block:language
let
space
position#\Spaceparameters
and
plusp
lengthparameters
subseqparameters0space
:texttext
make-instance'example-block:texttext
1+end
defunread-table
linesi
when
table-line-p
areflinesi
let
rows'
header-pnil
ji
loopwhile
and
<j
lengthlines
table-line-p
areflinesj
do
let
line
trim
areflinesj
if
starts-with"|-"line
when
=
lengthrows
1
setfheader-pt
push
mapcar
let
cells
split-on-bar
string-trim"|"line
cells
rows
incfj
values
make-instance'table:rows
nreverserows
:header-pheader-p
j
defunsplit-on-bar
string
loopwithstart=0forbar=
position#\|string:startstart
collect
subseqstringstartbar
whilebardo
setfstart
1+bar
defunread-list
linesi

Read a plain list whose first item begins at line I.

multiple-value-bind
indentordered-p
list-item-start
areflinesi
whenindent
let
items'
ji
loop
unless
<j
lengthlines
multiple-value-bind
item-indentitem-ordered-pbody-start
list-item-start
areflinesj
unless
anditem-indent
=item-indentindent
eqitem-ordered-pordered-p

Gather the item's lines: the first line's body, then every following line indented deeper than the bullet, allowing a blank line inside the item when more indented text follows.

let
body
list
subseq
areflinesj
body-start
k
1+j
loopwhile
<k
lengthlines
do
let
line
areflinesk
cond
if
and
<
1+k
lengthlines
not
blank-line-p
areflines
1+k
>
indentation
areflines
1+k
indent
push""body
>indent
push
subseqline
min
lengthline
body-start
body
incfk
push
make-instance'list-item:children
read-blocks
coerce
nreversebody
'vector
items
setfjk
values
make-instance'plain-list:ordered-pordered-p:children
nreverseitems
j
defunread-paragraph
linesi
let
ji
loopwhiledo
incfj
values
make-instance'paragraph:children
read-inlines
formatnil"~{~A~^~%~}"
loopforkfromibelowjcollect
trim
areflinesk
j
defparameter*block-readers*'"Block readers tried in order; READ-PARAGRAPH always succeeds."
defunread-block
linesi

Read the block beginning at line I, returning (values element next-index).

dolist
multiple-value-bind
funcallreaderlinesi
whenelement
return
valueselementnext
defunread-blocks
lines

Read the section body lines (a vector) into a list of block elements.

let
blocks'
i0
loopwhile
<i
lengthlines
do
if
blank-line-p
areflinesi
incfi
multiple-value-bind
pushelementblocks
setfinext
nreverseblocks

Document reader

defunread-property-drawer
linesi

If a property drawer begins at line I, return (values alist next-index).

when
and
<i
lengthlines
string-equal
trim
areflinesi
":PROPERTIES:"
let
properties'
loopforjfrom
1+i
below
lengthlines
forline=
trim
areflinesj
do
cond
string-equalline":END:"
return-fromread-property-drawer
values
nreverseproperties
1+j
and
plusp
lengthline
char=
charline0
#\:
let
close
position#\:line:start1
whenclose
push
cons
subseqline1close
trim
subseqline
1+close
properties
nil
defunread-heading-line
linestars

Split a headline into (values keyword title-inlines).

let*
rest
trim
subseqlinestars
space
position#\Spacerest
word
subseqrest0space
if
andspace
memberword*work-mark-keywords*:test#'string=
valuesword
read-inlines
trim
subseqrestspace
valuesnil
defunread-org-lines
lines&keynamepathname

Read the vector lines of an Org file into a document.

let*
document
make-instance'document:namename:pathnamepathname
keywords'
i0
n
lengthlines

File keywords come first; then the preamble section, then headings.

loopwhile
and
<in
or
blank-line-p
areflinesi
keyword-line-p
areflinesi
do
multiple-value-bind
keyvalue
keyword-line-p
areflinesi
whenkey
push
conskeyvalue
keywords
incfi
setf
document-keywordsdocument
nreversekeywords
labels
section-end
start
or
position-if#'heading-line-plines:startstart
n
read-section
start
let
end
section-endstart
values
read-blocks
subseqlinesstartend
end
read-headings
startmin-level

Read consecutive headings of level >= MIN-LEVEL starting at START; return (values headings next-index).

let
headings'
istart
loop
unless
<in
let
level
heading-line-p
areflinesi
unless
andlevel
>=levelmin-level
multiple-value-bind
keywordtitle
read-heading-line
areflinesi
level
multiple-value-bind
propertiesafter-drawer
multiple-value-bind
blockssection-end
read-section
orafter-drawer
1+i
multiple-value-bind
childrennext
read-headingssection-end
1+level
push
make-instance'heading:levellevel:titletitle:keywordkeyword:propertiesproperties:documentdocument:children
appendblockschildren
headings
setfinext
values
nreverseheadings
i
multiple-value-bind
preambleafter
read-sectioni
multiple-value-bind
headingsnext
read-headingsafter1
declare
ignorenext
setf
element-childrendocument
appendpreambleheadings
document
defunread-org-string
string&keynamepathname
read-org-lines
coerce
uiop:split-stringstring:separator'
#\Newline
'vector
:namename:pathnamepathname
defunread-org-file
pathname&key
name
pathname-namepathname

Read the Org file at pathname into a document.

read-org-lines
coerce
uiop:read-file-linespathname
'vector
:namename:pathnamepathname