+++ /dev/null
----
-postid: 000
-title: CL-WHO demo: The Coad Pit
-date: June 29, 2019
-author: Lucian Mogoșanu
-tags: tech, tmsr
----
-
-In the midst of an [ongoing battle][btcbase-1919627] with the monster
-that is [Hunchentoot][hunchentoot-i], I have received the suggestion
-that I can easily communicate intermediate results by simply posting
-said code on the web in an [annotatable form][btcbase-1919634]. I
-judge this to be a great idea, even though the items in question
-represent merely coad[^1]. Moreover, I've previously promised to
-provide examples for [other WWWisms][cl-who], and it occurs to me that
-this is just the right occasion to do so.
-
-Thus this post answers the following couple of questions: a. how can
-one use CL-WHO to generate a simple web site? and b. given a code base
-consisting of source code, how can we turn that into a HTMListic
-representation with per-line references, *using our tool*[^2]?
-
-[As previously described][cl-who-again] CL-WHO gives us a template
-language, wrapped around the `with-html-output` macro. For example, to
-write a simple web page to `*standard-output*`, one would write:
-
-~~~~ {.commonlisp}
-(cl-who:with-html-output (*standard-output*)
- (:html (:body
- (:b (cl-who:str "Hello, world!")))))
-~~~~
-
-which yields the output:
-
-~~~~
-<html><body><b>Hello, world!</b></body></html>
-~~~~
-
-First, let's make some sense of what we just wrote. The full
-description of the template language can be found in [the
-docs][cl-who-syntax], but in short, we: 1. define a context for HTML
-output; in which we 2. generate a HTML whose body contains; 3. a
-"bold" context, containing 4. the string (`str`) "Hello, world!".
-
-Now let's say we want to do something fancier, such as looping over a
-list of items:
-
-~~~~ {.commonlisp}
-(cl-who:with-html-output (*standard-output* nil)
- (:html (:body
- (:ul
- (loop for x in '(a b c d e f)
- for i = 1 then (1+ i) do
- (cl-who:htm
- (:li (cl-who:esc
- (format nil "[~d] ~s" i x))))))))))
-~~~~
-
-gives us:
-
-~~~~
-<html><body><ul><li>[1] A</li><li>[2] B</li><li>[3] C</li><li>[4] D</li><li>[5] E</li><li>[6] F</li></ul></body></html>
-~~~~
-
-In addition to the loop itself, this example has two unknowns, namely
-the `htm` and the `esc` keywords. Firstly, `esc` is very similar to
-the previously-presented `str`, only that it does a HTML escape (of
-e.g. ">" into ">").
-
-Secondly, `htm` is a sort of a shorthand for `with-html-output` that
-is necessary for the following reason: the HTML generation mechanism
-of WHO looks at cons cells whose first element is a keyword
-(interpreted as a HTML tag), and it collects them, until it reaches
-something else (e.g. our loop construct above). When it gets there, it
-treats the input as a standard S-expression, to be evaluated by the
-Lisp evaluator as-is. However, this S-expression now also contains the
-definition of `htm` in its macro-scope, which causes further
-occurences of `htm` to be expanded, which allows nested
-HTML-in-Lisp-in-HTML-... expressions.
-
-To put this convoluted[^3] explanation in simpler words:
-`with-html-output` throws us into a HTML template context; `loop` gets
-us out of there, but `htm` brings us back in, which is precisely the
-"mix HTML and CL" machinery at work. Use it wisely, and it shall serve
-you well.
-
-Now that we have these basics fixed, we can get to what really
-interests us, that is, a HTML representation of source code with
-line-by-line references. For the sake of simplicity and modularity, we
-are going to break this into a set of macros, each doing one
-thing. For example, the CL-WHO template for a line number:
-
-~~~~ {.commonlisp}
-(defmacro tcp-line-number (n &optional (padding 0))
- "Template for the line number."
- `(cl-who:str (format nil "~vd " ,padding ,n)))
-~~~~
-
-Note: the `~vd` format string allows us to do variable padding with
-spaces, which is quite useful here to keep our lines aligned. Next,
-the line content and the actual line:
-
-~~~~ {.commonlisp}
-(defmacro tcp-line-content (line)
- "Template for the line content."
- `(cl-who:esc ,line))
-
-(defmacro tcp-line (number padding content)
- "Template for the line."
- `(cl-who:htm
- (:span :class "line"
- :id (format nil "L~d" ,number)
- (:a :href (format nil "#L~d" ,number)
- :class "lineno"
- (tcp-line-number ,number ,padding))
- (:span :class "linecont"
- (tcp-line-content ,content)))
- (:br)))
-~~~~
-
-Next we need to put all the lines together in a code block, which for
-our convenience will be a `pre` tag:
-
-~~~~ {.commonlisp}
-(defmacro tcp-block (lines)
- "Template for generating a code block out of a list of lines."
- (with-gensyms (i padding line)
- `(cl-who:htm
- (:pre :class "coadblock"
- (loop for ,padding = (length (format nil "~d" (length ,lines)))
- for ,i = 1 then (1+ ,i)
- for ,line in ,lines do
- (tcp-line ,i ,padding ,line))))))
-~~~~
-
-... and, for even more convenience, we'll output a HTML header with
-some CSS to bellify the coad loox:
-
-~~~~ {.commonlisp}
-(defmacro tcp-html-header (title)
- `(cl-who:htm
- (:title (cl-who:str ,title))
- (:style :type "text/css"
- (cl-who:str "
-.coadblock {background-color:#e8e8e8;
- border-style:solid;border-width:1px;padding-left:5px;}
-.line {float:left; width:100%;}
-.lineno {font-weight:bold;text-decoration:none;color:black;}
-.lineno:visited {color:black;}
-:target {background-color:lightyellow;}"))))
-~~~~
-
-Finally, we put everything together in a function that receives a page
-title, a list of strings, each string a line in the source file, and
-outputs them into a file:
-
-~~~~ {.commonlisp}
-(defun write-code-page (title lines out-path)
- "Write LINES to OUT-PATH as a HTML file."
- (with-open-file (out out-path
- :direction :output
- :if-exists :supersede)
- (cl-who:with-html-output (out nil
- :prologue t
- :indent nil)
- (cl-who:htm
- (:html (:head (tcp-html-header title))
- (:body (:b (cl-who:str title))
- (tcp-block lines)))))))
-~~~~
-
-That's it, really, our coad-pit-generating coad. Go ahead and test
-it. This isn't quite the whole thing, but I'm deliberately omitting it
-since there's a lot of it that's out of the scope of a CL-WHO demo: we
-need to a. take a code base given as input, and; b. based on its input
-path and output path and; c. based on its path inside the website
-we're deploying to; d. we must process the code tree; and e. for each
-source file, output the generated page, and f. for each directory,
-create the output directory and output an index page. I initially
-thought this would fit in about two hundred lines of Lisp, but it runs
-a bit over three hundred, so I'm illustrating the demo by having it
-generate itself.
-
-The full coad can be examined on this [demo page][cl-who-demo]. For
-the future, I am preparing a new site, The Coad Pit, that will be soon
-available over at [coad.thetarpit.org][coad], containing e.g. CL-WHO,
-Hunchentoot and other coads and codes that I've gathered over time.
-
-[^1]: "Coad" is a TMSR term of art, representing, well... [let's
- see][btcbase-1760554]:
-
- > **mircea_popescu**: is "coad" code ?
- > **asciilifeform**: yea, but think 'with lower case c'
- > **asciilifeform**: i.e snippets
-
- In other words, coad is code that comes with no guarantees that
- it does what the author says it does, nor, in some cases, that
- it does anything useful at all, nor that it's usable, readable,
- fittable in head and so on -- making its value as a published
- item somewhat questionable. However, [some] coad may have the
- potential to be turned into actual code, i.e. into something
- that I for example could sign without thinking twice, which is
- why putting coad on the 'net in some form or the other is not at
- all a useless endeavour.
-
-[^2]: There's nothing fundamentally new in "code sites". Shithub does
- it, owing to ye olde [LXR][lxr]; meanwhile, Phf's btcbase has a
- very neat [V patch explorer][btcbase-patches] that's been in
- Republican use for years now.
-
- So the only thing I'm adding to it is the didactic aspect, I
- guess.
-
-[^3]: The reader might get a reasonably good insight on what happens
- behind the scenes by running `macroexpand-1` on the example
- presented. Other than that, it's just CL macros all the way
- down, and this unfortunately can't be properly explained in this
- humble article.
-
-[btcbase-1919627]: http://btcbase.org/log/2019-06-23#1919627
-[hunchentoot-i]: /posts/y05/093-hunchentoot-i.html
-[btcbase-1919634]: http://btcbase.org/log/2019-06-23#1919634
-[btcbase-1760554]: http://btcbase.org/log/2017-12-29#1760554
-[cl-who]: /posts/y05/092-cl-who.html#selection-71.157-75.46
-[lxr]: http://archive.is/O6l48
-[btcbase-patches]: http://btcbase.org/patches
-[cl-who-again]: http://thetarpit.org/posts/y05/092-cl-who.html#selection-67.223-67.610
-[cl-who-syntax]: http://archive.is/3kH5V#selection-835.0-835.20
-[cl-who-demo]: /uploads/2019/06/cl-who-demo/
-[coad]: http://coad.thetarpit.org/
--- /dev/null
+---
+postid: 095
+title: CL-WHO demo: The Coad Pit
+date: July 5, 2019
+author: Lucian Mogoșanu
+tags: tech, tmsr
+---
+
+In the midst of an [ongoing battle][btcbase-1919627] with the monster
+that is [Hunchentoot][hunchentoot-i], I have received the suggestion
+that I can easily communicate intermediate results by simply posting
+said code on the web in an [annotatable form][btcbase-1919634]. I
+judge this to be an excellent idea, even though the items in question
+represent merely coad[^1]. Moreover, since I've previously promised to
+provide examples for [other CL WWWisms][cl-who], it occurs to me that
+this is just the right occasion to do so.
+
+Thus this post answers the following couple of questions: a. how can
+one use CL-WHO to generate a simple web site? and b. given a code base
+consisting of source code, how can we turn that into a HTMListic
+representation with per-line references, *using our tool*[^2]?
+
+[As previously described][cl-who-again], CL-WHO gives us a template
+language, wrapped around the `with-html-output` macro. For example, to
+print a simple web page to standard output, one would write:
+
+~~~~ {.commonlisp}
+(cl-who:with-html-output (*standard-output*)
+ (:html (:body
+ (:b (cl-who:str "Hello, world!")))))
+~~~~
+
+which yields the output:
+
+~~~~
+<html><body><b>Hello, world!</b></body></html>
+~~~~
+
+First, let's make some sense of what we just wrote. The full
+description of the template language can be found in [the
+docs][cl-who-syntax], but in short, we: 1. define a context for HTML
+output; in which we 2. generate a "<html>" whose body
+contains; 3. a "bold" context, containing 4. the string (`str`)
+"Hello, world!".
+
+Now let's say we want to do something fancier, such as mechanically
+generating a list of items. Then:
+
+~~~~ {.commonlisp}
+(cl-who:with-html-output (*standard-output* nil)
+ (:html (:body
+ (:ul
+ (loop for x in '(a b c d e f)
+ for i = 1 then (1+ i) do
+ (cl-who:htm
+ (:li (cl-who:esc
+ (format nil "[~d] ~s" i x))))))))))
+~~~~
+
+gives us:
+
+~~~~
+<html><body><ul><li>[1] A</li><li>[2] B</li><li>[3] C</li><li>[4] D</li><li>[5] E</li><li>[6] F</li></ul></body></html>
+~~~~
+
+In addition to the loop construct, this example has two new elements,
+namely the `htm` and the `esc` symbols. Firstly, `esc` is very similar
+to the previously-presented `str`, only that it does a HTML escape (of
+e.g. ">" into "&gt;").
+
+Secondly, `htm` is a sort of a shorthand for `with-html-output` that
+is useful for the following: the HTML generation mechanism of WHO
+looks at cons cells whose first element is a keyword (interpreted as a
+HTML tag) and it collects them, until it reaches another form --
+e.g. our loop construct above. When it gets there, it treats the input
+as a standard S-expression, to be evaluated by the Lisp evaluator
+as-is. However, this S-expression now also contains the definition of
+`htm` in its macro-scope, which causes further occurences of `htm` to
+be expanded, which allows nested HTML-in-Lisp-in-HTML-... expressions.
+
+To put this convoluted[^3] explanation in simpler words:
+`with-html-output` throws us into a HTML template context; `loop` (or
+some other CL control structure) gets us out of there, but `htm`
+brings us back in, which is precisely the "mix HTML and CL" machinery
+at work. Use it wisely, and it shall serve you well.
+
+Now that we have these basics settled, we can get to what really
+interests us, that is, a HTML representation of source code with
+line-by-line references. For the sake of simplicity and modularity, we
+are going to break this into a set of macros, each doing one
+thing. For example, the CL-WHO template for a line number:
+
+~~~~ {.commonlisp}
+(defmacro tcp-line-number (n &optional (padding 0))
+ "Template for the line number."
+ `(cl-who:str (format nil "~vd " ,padding ,n)))
+~~~~
+
+Note: the `~vd` format string allows us to do variable padding with
+spaces, which is quite useful here to keep our lines aligned. Next,
+the line content and the actual line:
+
+~~~~ {.commonlisp}
+(defmacro tcp-line-content (line)
+ "Template for the line content."
+ `(cl-who:esc ,line))
+
+(defmacro tcp-line (number padding content)
+ "Template for the line."
+ `(cl-who:htm
+ (:span :class "line"
+ :id (format nil "L~d" ,number)
+ (:a :href (format nil "#L~d" ,number)
+ :class "lineno"
+ (tcp-line-number ,number ,padding))
+ (:span :class "linecont"
+ (tcp-line-content ,content)))
+ (:br)))
+~~~~
+
+Next we need to put all the lines together in a code block, which for
+our convenience will be delimited by a "<pre>" tag:
+
+~~~~ {.commonlisp}
+(defmacro tcp-block (lines)
+ "Template for generating a code block out of a list of lines."
+ (with-gensyms (i padding line)
+ `(cl-who:htm
+ (:pre :class "coadblock"
+ (loop for ,padding = (length (format nil "~d" (length ,lines)))
+ for ,i = 1 then (1+ ,i)
+ for ,line in ,lines do
+ (tcp-line ,i ,padding ,line))))))
+~~~~
+
+... and, for even more convenience, we'll output a HTML header with
+some CSS to bellify the coad loox:
+
+~~~~ {.commonlisp}
+(defmacro tcp-html-header (title)
+ `(cl-who:htm
+ (:title (cl-who:str ,title))
+ (:style :type "text/css"
+ (cl-who:str "
+.coadblock {background-color:#e8e8e8;
+ border-style:solid;border-width:1px;padding-left:5px;}
+.line {float:left; width:100%;}
+.lineno {font-weight:bold;text-decoration:none;color:black;}
+.lineno:visited {color:black;}
+:target {background-color:lightyellow;}"))))
+~~~~
+
+Finally, we put everything together in a function that receives a page
+title, a list of strings, each string a line in the source file, and
+outputs them into a file:
+
+~~~~ {.commonlisp}
+(defun write-code-page (title lines out-path)
+ "Write LINES to OUT-PATH as a HTML file."
+ (with-open-file (out out-path
+ :direction :output
+ :if-exists :supersede)
+ (cl-who:with-html-output (out nil
+ :prologue t
+ :indent nil)
+ (cl-who:htm
+ (:html (:head (tcp-html-header title))
+ (:body (:b (cl-who:str title))
+ (tcp-block lines)))))))
+~~~~
+
+That's it, really, our coad-pit-generating coad. Go ahead and test
+it. This isn't quite the whole thing, but I'm deliberately omitting
+the rest since there's a lot of functionality going beyond our CL-WHO
+demo: we need to a. take a code base given as input, and; b. based on
+its input path and output path and; c. based on its path inside the
+website we're deploying to; d. we must process the code tree; and
+e. for each source file, output the generated page, and f. for each
+directory, create the output directory and output an index page. I
+initially thought this would fit in about two hundred lines of Lisp,
+but it runs a bit over three hundred, so I'm illustrating the demo by
+having it generate itself.
+
+The full demo coad can be examined on [this page][cl-who-demo]. For
+the future I am preparing a new site, The Coad Pit, available over at
+[coad.thetarpit.org][coad], containing e.g. CL-WHO, Hunchentoot and
+other coads and codes that I've gathered over time. It's still very
+rough around the edges, but don't hesitate to play with it.
+
+[^1]: "Coad" is a term of art, representing, well... [let's
+ see][btcbase-1760554]:
+
+ > **mircea_popescu**: is "coad" code ?
+ > **asciilifeform**: yea, but think 'with lower case c'
+ > **asciilifeform**: i.e snippets
+
+ In other words, coad is code that comes with no guarantees that
+ it does what the author says it does, nor, in some cases, that
+ it does anything useful at all, nor that it's usable, readable,
+ fittable in head and so on -- making its value as a published
+ item somewhat questionable. However, (some) coad may have the
+ potential to be turned into actual code, i.e. into something
+ that I for example could sign without thinking twice, which is
+ why putting coad on the 'net in some form or the other is not at
+ all a useless endeavour.
+
+[^2]: There's nothing fundamentally new in "code sites". Shithub does
+ it, owing to ye olde [LXR][lxr]; meanwhile, Phf's btcbase has a
+ very neat [V patch explorer][btcbase-patches] that's been in
+ Republican use for years now.
+
+ So the only thing I'm adding to it is the didactic aspect, I
+ guess.
+
+[^3]: The reader might get a reasonably good insight on what happens
+ behind the scenes by running `macroexpand-1` on the example
+ presented. Other than that, it's just CL macros all the way
+ down, which exercise unfortunately goes way beyond the scope of
+ this humble article.
+
+[btcbase-1919627]: http://btcbase.org/log/2019-06-23#1919627
+[hunchentoot-i]: /posts/y05/093-hunchentoot-i.html
+[btcbase-1919634]: http://btcbase.org/log/2019-06-23#1919634
+[btcbase-1760554]: http://btcbase.org/log/2017-12-29#1760554
+[cl-who]: /posts/y05/092-cl-who.html#selection-71.157-75.46
+[lxr]: http://archive.is/O6l48
+[btcbase-patches]: http://btcbase.org/patches
+[cl-who-again]: http://thetarpit.org/posts/y05/092-cl-who.html#selection-67.223-67.610
+[cl-who-syntax]: http://archive.is/3kH5V#selection-835.0-835.20
+[cl-who-demo]: /uploads/2019/07/cl-who-demo/
+[coad]: http://coad.thetarpit.org/
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html><head><title>demo.lisp</title><style type='text/css'>
+.coadblock {background-color:#e8e8e8;
+ border-style:solid;border-width:1px;padding-left:5px;}
+.line {float:left; width:100%;}
+.lineno {font-weight:bold;text-decoration:none;color:black;}
+.lineno:visited {color:black;}
+:target {background-color:lightyellow;}</style></head><body><b>demo.lisp</b><pre class='coadblock'><span class='line' id='L1'><a href='#L1' class='lineno'> 1 </a><span class='linecont'>;; CL-WHO demo: The Coad Pit (TCP).</span></span><br /><span class='line' id='L2'><a href='#L2' class='lineno'> 2 </a><span class='linecont'></span></span><br /><span class='line' id='L3'><a href='#L3' class='lineno'> 3 </a><span class='linecont'>;; Utilities:</span></span><br /><span class='line' id='L4'><a href='#L4' class='lineno'> 4 </a><span class='linecont'>(defmacro with-gensyms ((&rest names) &body body)</span></span><br /><span class='line' id='L5'><a href='#L5' class='lineno'> 5 </a><span class='linecont'> `(let ,(loop for n in names collect `(,n (gensym)))</span></span><br /><span class='line' id='L6'><a href='#L6' class='lineno'> 6 </a><span class='linecont'> ,@body))</span></span><br /><span class='line' id='L7'><a href='#L7' class='lineno'> 7 </a><span class='linecont'></span></span><br /><span class='line' id='L8'><a href='#L8' class='lineno'> 8 </a><span class='linecont'>(defun concatenate-pathname-dirs (pathname1 pathname2)</span></span><br /><span class='line' id='L9'><a href='#L9' class='lineno'> 9 </a><span class='linecont'> "The result will be a file with the directories of PATHNAME1 and</span></span><br /><span class='line' id='L10'><a href='#L10' class='lineno'> 10 </a><span class='linecont'>PATHNAME2 concatenated.</span></span><br /><span class='line' id='L11'><a href='#L11' class='lineno'> 11 </a><span class='linecont'></span></span><br /><span class='line' id='L12'><a href='#L12' class='lineno'> 12 </a><span class='linecont'>File names and types of PATHNAMEs are ignored."</span></span><br /><span class='line' id='L13'><a href='#L13' class='lineno'> 13 </a><span class='linecont'> (let ((dir1 (pathname-directory pathname1))</span></span><br /><span class='line' id='L14'><a href='#L14' class='lineno'> 14 </a><span class='linecont'> (dir2 (pathname-directory pathname2)))</span></span><br /><span class='line' id='L15'><a href='#L15' class='lineno'> 15 </a><span class='linecont'> (make-pathname :directory</span></span><br /><span class='line' id='L16'><a href='#L16' class='lineno'> 16 </a><span class='linecont'> (append dir1 (cdr dir2))</span></span><br /><span class='line' id='L17'><a href='#L17' class='lineno'> 17 </a><span class='linecont'> :name (pathname-name pathname2)</span></span><br /><span class='line' id='L18'><a href='#L18' class='lineno'> 18 </a><span class='linecont'> :type (pathname-type pathname2))))</span></span><br /><span class='line' id='L19'><a href='#L19' class='lineno'> 19 </a><span class='linecont'></span></span><br /><span class='line' id='L20'><a href='#L20' class='lineno'> 20 </a><span class='linecont'>(defun read-file-lines (pathspec)</span></span><br /><span class='line' id='L21'><a href='#L21' class='lineno'> 21 </a><span class='linecont'> "Read lines in file pointed to by PATHSPEC one by one and return</span></span><br /><span class='line' id='L22'><a href='#L22' class='lineno'> 22 </a><span class='linecont'>them in a list."</span></span><br /><span class='line' id='L23'><a href='#L23' class='lineno'> 23 </a><span class='linecont'> (with-open-file (in pathspec)</span></span><br /><span class='line' id='L24'><a href='#L24' class='lineno'> 24 </a><span class='linecont'> (loop for line = (read-line in nil :eof)</span></span><br /><span class='line' id='L25'><a href='#L25' class='lineno'> 25 </a><span class='linecont'> until (eq line :eof)</span></span><br /><span class='line' id='L26'><a href='#L26' class='lineno'> 26 </a><span class='linecont'> collect line)))</span></span><br /><span class='line' id='L27'><a href='#L27' class='lineno'> 27 </a><span class='linecont'></span></span><br /><span class='line' id='L28'><a href='#L28' class='lineno'> 28 </a><span class='linecont'>;; Part one: code page generation</span></span><br /><span class='line' id='L29'><a href='#L29' class='lineno'> 29 </a><span class='linecont'></span></span><br /><span class='line' id='L30'><a href='#L30' class='lineno'> 30 </a><span class='linecont'>;; A line has two components: a number and its content.</span></span><br /><span class='line' id='L31'><a href='#L31' class='lineno'> 31 </a><span class='linecont'>(defmacro tcp-line-number (n &optional (padding 0))</span></span><br /><span class='line' id='L32'><a href='#L32' class='lineno'> 32 </a><span class='linecont'> "Template for the line number."</span></span><br /><span class='line' id='L33'><a href='#L33' class='lineno'> 33 </a><span class='linecont'> `(cl-who:str (format nil "~vd " ,padding ,n)))</span></span><br /><span class='line' id='L34'><a href='#L34' class='lineno'> 34 </a><span class='linecont'></span></span><br /><span class='line' id='L35'><a href='#L35' class='lineno'> 35 </a><span class='linecont'>(defmacro tcp-line-content (line)</span></span><br /><span class='line' id='L36'><a href='#L36' class='lineno'> 36 </a><span class='linecont'> "Template for the line content."</span></span><br /><span class='line' id='L37'><a href='#L37' class='lineno'> 37 </a><span class='linecont'> `(cl-who:esc ,line))</span></span><br /><span class='line' id='L38'><a href='#L38' class='lineno'> 38 </a><span class='linecont'></span></span><br /><span class='line' id='L39'><a href='#L39' class='lineno'> 39 </a><span class='linecont'>(defmacro tcp-line (number padding content)</span></span><br /><span class='line' id='L40'><a href='#L40' class='lineno'> 40 </a><span class='linecont'> "Template for the line."</span></span><br /><span class='line' id='L41'><a href='#L41' class='lineno'> 41 </a><span class='linecont'> `(cl-who:htm</span></span><br /><span class='line' id='L42'><a href='#L42' class='lineno'> 42 </a><span class='linecont'> (:span :class "line"</span></span><br /><span class='line' id='L43'><a href='#L43' class='lineno'> 43 </a><span class='linecont'> :id (format nil "L~d" ,number)</span></span><br /><span class='line' id='L44'><a href='#L44' class='lineno'> 44 </a><span class='linecont'> (:a :href (format nil "#L~d" ,number)</span></span><br /><span class='line' id='L45'><a href='#L45' class='lineno'> 45 </a><span class='linecont'> :class "lineno"</span></span><br /><span class='line' id='L46'><a href='#L46' class='lineno'> 46 </a><span class='linecont'> (tcp-line-number ,number ,padding))</span></span><br /><span class='line' id='L47'><a href='#L47' class='lineno'> 47 </a><span class='linecont'> (:span :class "linecont"</span></span><br /><span class='line' id='L48'><a href='#L48' class='lineno'> 48 </a><span class='linecont'> (tcp-line-content ,content)))</span></span><br /><span class='line' id='L49'><a href='#L49' class='lineno'> 49 </a><span class='linecont'> (:br)))</span></span><br /><span class='line' id='L50'><a href='#L50' class='lineno'> 50 </a><span class='linecont'></span></span><br /><span class='line' id='L51'><a href='#L51' class='lineno'> 51 </a><span class='linecont'>;; A code block is a list of lines.</span></span><br /><span class='line' id='L52'><a href='#L52' class='lineno'> 52 </a><span class='linecont'>(defmacro tcp-block (lines)</span></span><br /><span class='line' id='L53'><a href='#L53' class='lineno'> 53 </a><span class='linecont'> "Template for generating a code block out of a list of lines."</span></span><br /><span class='line' id='L54'><a href='#L54' class='lineno'> 54 </a><span class='linecont'> (with-gensyms (i padding line)</span></span><br /><span class='line' id='L55'><a href='#L55' class='lineno'> 55 </a><span class='linecont'> `(cl-who:htm</span></span><br /><span class='line' id='L56'><a href='#L56' class='lineno'> 56 </a><span class='linecont'> (:pre :class "coadblock"</span></span><br /><span class='line' id='L57'><a href='#L57' class='lineno'> 57 </a><span class='linecont'> (loop for ,padding = (length (format nil "~d" (length ,lines)))</span></span><br /><span class='line' id='L58'><a href='#L58' class='lineno'> 58 </a><span class='linecont'> for ,i = 1 then (1+ ,i)</span></span><br /><span class='line' id='L59'><a href='#L59' class='lineno'> 59 </a><span class='linecont'> for ,line in ,lines do</span></span><br /><span class='line' id='L60'><a href='#L60' class='lineno'> 60 </a><span class='linecont'> (tcp-line ,i ,padding ,line))))))</span></span><br /><span class='line' id='L61'><a href='#L61' class='lineno'> 61 </a><span class='linecont'></span></span><br /><span class='line' id='L62'><a href='#L62' class='lineno'> 62 </a><span class='linecont'>;; The header contains a title and some CSS.</span></span><br /><span class='line' id='L63'><a href='#L63' class='lineno'> 63 </a><span class='linecont'>(defmacro tcp-html-header (title)</span></span><br /><span class='line' id='L64'><a href='#L64' class='lineno'> 64 </a><span class='linecont'> `(cl-who:htm</span></span><br /><span class='line' id='L65'><a href='#L65' class='lineno'> 65 </a><span class='linecont'> (:title (cl-who:str ,title))</span></span><br /><span class='line' id='L66'><a href='#L66' class='lineno'> 66 </a><span class='linecont'> (:style :type "text/css"</span></span><br /><span class='line' id='L67'><a href='#L67' class='lineno'> 67 </a><span class='linecont'> (cl-who:str "</span></span><br /><span class='line' id='L68'><a href='#L68' class='lineno'> 68 </a><span class='linecont'>.coadblock {background-color:#e8e8e8;</span></span><br /><span class='line' id='L69'><a href='#L69' class='lineno'> 69 </a><span class='linecont'> border-style:solid;border-width:1px;padding-left:5px;}</span></span><br /><span class='line' id='L70'><a href='#L70' class='lineno'> 70 </a><span class='linecont'>.line {float:left; width:100%;}</span></span><br /><span class='line' id='L71'><a href='#L71' class='lineno'> 71 </a><span class='linecont'>.lineno {font-weight:bold;text-decoration:none;color:black;}</span></span><br /><span class='line' id='L72'><a href='#L72' class='lineno'> 72 </a><span class='linecont'>.lineno:visited {color:black;}</span></span><br /><span class='line' id='L73'><a href='#L73' class='lineno'> 73 </a><span class='linecont'>:target {background-color:lightyellow;}"))))</span></span><br /><span class='line' id='L74'><a href='#L74' class='lineno'> 74 </a><span class='linecont'></span></span><br /><span class='line' id='L75'><a href='#L75' class='lineno'> 75 </a><span class='linecont'>;; Print this to output file.</span></span><br /><span class='line' id='L76'><a href='#L76' class='lineno'> 76 </a><span class='linecont'>(defun write-code-page (title lines out-path)</span></span><br /><span class='line' id='L77'><a href='#L77' class='lineno'> 77 </a><span class='linecont'> "Write LINES to OUT-PATH as a HTML file."</span></span><br /><span class='line' id='L78'><a href='#L78' class='lineno'> 78 </a><span class='linecont'> (with-open-file (out out-path</span></span><br /><span class='line' id='L79'><a href='#L79' class='lineno'> 79 </a><span class='linecont'> :direction :output</span></span><br /><span class='line' id='L80'><a href='#L80' class='lineno'> 80 </a><span class='linecont'> :if-exists :supersede)</span></span><br /><span class='line' id='L81'><a href='#L81' class='lineno'> 81 </a><span class='linecont'> (cl-who:with-html-output (out nil</span></span><br /><span class='line' id='L82'><a href='#L82' class='lineno'> 82 </a><span class='linecont'> :prologue t</span></span><br /><span class='line' id='L83'><a href='#L83' class='lineno'> 83 </a><span class='linecont'> :indent nil)</span></span><br /><span class='line' id='L84'><a href='#L84' class='lineno'> 84 </a><span class='linecont'> (cl-who:htm</span></span><br /><span class='line' id='L85'><a href='#L85' class='lineno'> 85 </a><span class='linecont'> (:html (:head (tcp-html-header title))</span></span><br /><span class='line' id='L86'><a href='#L86' class='lineno'> 86 </a><span class='linecont'> (:body (:b (cl-who:str title))</span></span><br /><span class='line' id='L87'><a href='#L87' class='lineno'> 87 </a><span class='linecont'> (tcp-block lines)))))))</span></span><br /><span class='line' id='L88'><a href='#L88' class='lineno'> 88 </a><span class='linecont'></span></span><br /><span class='line' id='L89'><a href='#L89' class='lineno'> 89 </a><span class='linecont'>;; Example:</span></span><br /><span class='line' id='L90'><a href='#L90' class='lineno'> 90 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L91'><a href='#L91' class='lineno'> 91 </a><span class='linecont'>;; (lines-to-file</span></span><br /><span class='line' id='L92'><a href='#L92' class='lineno'> 92 </a><span class='linecont'>;; "A Testes"</span></span><br /><span class='line' id='L93'><a href='#L93' class='lineno'> 93 </a><span class='linecont'>;; (loop for i from 1 to 20 collect (format nil "line ~d" i))</span></span><br /><span class='line' id='L94'><a href='#L94' class='lineno'> 94 </a><span class='linecont'>;; "/virtual/sites/lucian.mogosanu.ro/randomio/test-who.html")</span></span><br /><span class='line' id='L95'><a href='#L95' class='lineno'> 95 </a><span class='linecont'></span></span><br /><span class='line' id='L96'><a href='#L96' class='lineno'> 96 </a><span class='linecont'>;; Part two: code tree processing</span></span><br /><span class='line' id='L97'><a href='#L97' class='lineno'> 97 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L98'><a href='#L98' class='lineno'> 98 </a><span class='linecont'>;; We need to:</span></span><br /><span class='line' id='L99'><a href='#L99' class='lineno'> 99 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L100'><a href='#L100' class='lineno'>100 </a><span class='linecont'>;; - turn filesystem paths into a walkable tree format;</span></span><br /><span class='line' id='L101'><a href='#L101' class='lineno'>101 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L102'><a href='#L102' class='lineno'>102 </a><span class='linecont'>;; - for each directory, be able to generate an index file containing</span></span><br /><span class='line' id='L103'><a href='#L103' class='lineno'>103 </a><span class='linecont'>;; links to files and subdirectories; and</span></span><br /><span class='line' id='L104'><a href='#L104' class='lineno'>104 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L105'><a href='#L105' class='lineno'>105 </a><span class='linecont'>;; - walk said tree and generate code and index pages.</span></span><br /><span class='line' id='L106'><a href='#L106' class='lineno'>106 </a><span class='linecont'></span></span><br /><span class='line' id='L107'><a href='#L107' class='lineno'>107 </a><span class='linecont'>;; A tree is one of the following two things:</span></span><br /><span class='line' id='L108'><a href='#L108' class='lineno'>108 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L109'><a href='#L109' class='lineno'>109 </a><span class='linecont'>;; - a pathname with the NAME set to a string; or</span></span><br /><span class='line' id='L110'><a href='#L110' class='lineno'>110 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L111'><a href='#L111' class='lineno'>111 </a><span class='linecont'>;; - a list whose first element is a pathname with the DIRECTORY set</span></span><br /><span class='line' id='L112'><a href='#L112' class='lineno'>112 </a><span class='linecont'>;; to a path and the NAME is not set; the other list elements are</span></span><br /><span class='line' id='L113'><a href='#L113' class='lineno'>113 </a><span class='linecont'>;; trees.</span></span><br /><span class='line' id='L114'><a href='#L114' class='lineno'>114 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L115'><a href='#L115' class='lineno'>115 </a><span class='linecont'>;; For example: (#p"/" #p"a" (#p"/dir/" #p"b" #p"c") #p"d")</span></span><br /><span class='line' id='L116'><a href='#L116' class='lineno'>116 </a><span class='linecont'></span></span><br /><span class='line' id='L117'><a href='#L117' class='lineno'>117 </a><span class='linecont'>(defun extract-tree (pathspec)</span></span><br /><span class='line' id='L118'><a href='#L118' class='lineno'>118 </a><span class='linecont'> "Recursively extract a tree from PATHSPEC."</span></span><br /><span class='line' id='L119'><a href='#L119' class='lineno'>119 </a><span class='linecont'></span></span><br /><span class='line' id='L120'><a href='#L120' class='lineno'>120 </a><span class='linecont'> ;; If PATHSPEC is not a pathname, turn it into one.</span></span><br /><span class='line' id='L121'><a href='#L121' class='lineno'>121 </a><span class='linecont'> (when (stringp pathspec)</span></span><br /><span class='line' id='L122'><a href='#L122' class='lineno'>122 </a><span class='linecont'> (setq pathspec (pathname pathspec)))</span></span><br /><span class='line' id='L123'><a href='#L123' class='lineno'>123 </a><span class='linecont'></span></span><br /><span class='line' id='L124'><a href='#L124' class='lineno'>124 </a><span class='linecont'> ;; Determine the type of node we're dealing with</span></span><br /><span class='line' id='L125'><a href='#L125' class='lineno'>125 </a><span class='linecont'> (let ((dir (pathname-directory pathspec))</span></span><br /><span class='line' id='L126'><a href='#L126' class='lineno'>126 </a><span class='linecont'> (name (pathname-name pathspec))</span></span><br /><span class='line' id='L127'><a href='#L127' class='lineno'>127 </a><span class='linecont'> (type (pathname-type pathspec)))</span></span><br /><span class='line' id='L128'><a href='#L128' class='lineno'>128 </a><span class='linecont'> (cond</span></span><br /><span class='line' id='L129'><a href='#L129' class='lineno'>129 </a><span class='linecont'> (name (make-pathname :name name :type type))</span></span><br /><span class='line' id='L130'><a href='#L130' class='lineno'>130 </a><span class='linecont'> (dir (let ((files (directory (make-pathname :directory dir</span></span><br /><span class='line' id='L131'><a href='#L131' class='lineno'>131 </a><span class='linecont'> :name :wild</span></span><br /><span class='line' id='L132'><a href='#L132' class='lineno'>132 </a><span class='linecont'> :type :wild))))</span></span><br /><span class='line' id='L133'><a href='#L133' class='lineno'>133 </a><span class='linecont'> (cons pathspec</span></span><br /><span class='line' id='L134'><a href='#L134' class='lineno'>134 </a><span class='linecont'> (mapcar #'extract-tree files)))))))</span></span><br /><span class='line' id='L135'><a href='#L135' class='lineno'>135 </a><span class='linecont'></span></span><br /><span class='line' id='L136'><a href='#L136' class='lineno'>136 </a><span class='linecont'>(defun normalized-tree (tree)</span></span><br /><span class='line' id='L137'><a href='#L137' class='lineno'>137 </a><span class='linecont'> "Normalize TREE by removing the common part of the path in all</span></span><br /><span class='line' id='L138'><a href='#L138' class='lineno'>138 </a><span class='linecont'>directories.</span></span><br /><span class='line' id='L139'><a href='#L139' class='lineno'>139 </a><span class='linecont'></span></span><br /><span class='line' id='L140'><a href='#L140' class='lineno'>140 </a><span class='linecont'>This function assumes TREE was obtained using EXTRACT-TREE."</span></span><br /><span class='line' id='L141'><a href='#L141' class='lineno'>141 </a><span class='linecont'> (let ((root-pathspec (car tree)))</span></span><br /><span class='line' id='L142'><a href='#L142' class='lineno'>142 </a><span class='linecont'> (labels ((recurse (tree)</span></span><br /><span class='line' id='L143'><a href='#L143' class='lineno'>143 </a><span class='linecont'> ;; This doesn't do anything for non-directory files.</span></span><br /><span class='line' id='L144'><a href='#L144' class='lineno'>144 </a><span class='linecont'> (when (pathnamep tree)</span></span><br /><span class='line' id='L145'><a href='#L145' class='lineno'>145 </a><span class='linecont'> (return-from recurse tree))</span></span><br /><span class='line' id='L146'><a href='#L146' class='lineno'>146 </a><span class='linecont'> (let ((dircopy (copy-list</span></span><br /><span class='line' id='L147'><a href='#L147' class='lineno'>147 </a><span class='linecont'> (pathname-directory root-pathspec)))</span></span><br /><span class='line' id='L148'><a href='#L148' class='lineno'>148 </a><span class='linecont'> (curr-dir (pathname-directory (car tree))))</span></span><br /><span class='line' id='L149'><a href='#L149' class='lineno'>149 </a><span class='linecont'> ;; Get rid of common parts...</span></span><br /><span class='line' id='L150'><a href='#L150' class='lineno'>150 </a><span class='linecont'> (loop until (null dircopy) do</span></span><br /><span class='line' id='L151'><a href='#L151' class='lineno'>151 </a><span class='linecont'> (pop dircopy)</span></span><br /><span class='line' id='L152'><a href='#L152' class='lineno'>152 </a><span class='linecont'> (pop curr-dir))</span></span><br /><span class='line' id='L153'><a href='#L153' class='lineno'>153 </a><span class='linecont'> ;; Set normalized path</span></span><br /><span class='line' id='L154'><a href='#L154' class='lineno'>154 </a><span class='linecont'> (push :absolute curr-dir)</span></span><br /><span class='line' id='L155'><a href='#L155' class='lineno'>155 </a><span class='linecont'> ;; Now recurse into the rest of the tree</span></span><br /><span class='line' id='L156'><a href='#L156' class='lineno'>156 </a><span class='linecont'> (cons (make-pathname :directory curr-dir)</span></span><br /><span class='line' id='L157'><a href='#L157' class='lineno'>157 </a><span class='linecont'> (mapcar #'(lambda (tree)</span></span><br /><span class='line' id='L158'><a href='#L158' class='lineno'>158 </a><span class='linecont'> (recurse tree))</span></span><br /><span class='line' id='L159'><a href='#L159' class='lineno'>159 </a><span class='linecont'> (cdr tree))))))</span></span><br /><span class='line' id='L160'><a href='#L160' class='lineno'>160 </a><span class='linecont'> (recurse tree))))</span></span><br /><span class='line' id='L161'><a href='#L161' class='lineno'>161 </a><span class='linecont'></span></span><br /><span class='line' id='L162'><a href='#L162' class='lineno'>162 </a><span class='linecont'>(defmacro tcp-html-path (dir name type)</span></span><br /><span class='line' id='L163'><a href='#L163' class='lineno'>163 </a><span class='linecont'> `(make-pathname :directory ,dir</span></span><br /><span class='line' id='L164'><a href='#L164' class='lineno'>164 </a><span class='linecont'> :name (format nil "c-~a~@[.~a~]" ,name ,type)</span></span><br /><span class='line' id='L165'><a href='#L165' class='lineno'>165 </a><span class='linecont'> :type "html"))</span></span><br /><span class='line' id='L166'><a href='#L166' class='lineno'>166 </a><span class='linecont'></span></span><br /><span class='line' id='L167'><a href='#L167' class='lineno'>167 </a><span class='linecont'>;; Links to files...</span></span><br /><span class='line' id='L168'><a href='#L168' class='lineno'>168 </a><span class='linecont'>(defmacro tcp-file-link (parent-pathspec pathspec &key (uri-prefix #p"/"))</span></span><br /><span class='line' id='L169'><a href='#L169' class='lineno'>169 </a><span class='linecont'> (with-gensyms (dir name type)</span></span><br /><span class='line' id='L170'><a href='#L170' class='lineno'>170 </a><span class='linecont'> `(let ((,dir (pathname-directory ,parent-pathspec))</span></span><br /><span class='line' id='L171'><a href='#L171' class='lineno'>171 </a><span class='linecont'> (,name (pathname-name ,pathspec))</span></span><br /><span class='line' id='L172'><a href='#L172' class='lineno'>172 </a><span class='linecont'> (,type (pathname-type ,pathspec)))</span></span><br /><span class='line' id='L173'><a href='#L173' class='lineno'>173 </a><span class='linecont'> (cl-who:htm</span></span><br /><span class='line' id='L174'><a href='#L174' class='lineno'>174 </a><span class='linecont'> (:em (cl-who:str "[f] "))</span></span><br /><span class='line' id='L175'><a href='#L175' class='lineno'>175 </a><span class='linecont'> (:a :class "filelink"</span></span><br /><span class='line' id='L176'><a href='#L176' class='lineno'>176 </a><span class='linecont'> :href (namestring (merge-pathnames</span></span><br /><span class='line' id='L177'><a href='#L177' class='lineno'>177 </a><span class='linecont'> (concatenate-pathname-dirs ,uri-prefix</span></span><br /><span class='line' id='L178'><a href='#L178' class='lineno'>178 </a><span class='linecont'> ,parent-pathspec)</span></span><br /><span class='line' id='L179'><a href='#L179' class='lineno'>179 </a><span class='linecont'> (tcp-html-path ,dir ,name, type)))</span></span><br /><span class='line' id='L180'><a href='#L180' class='lineno'>180 </a><span class='linecont'> (cl-who:esc</span></span><br /><span class='line' id='L181'><a href='#L181' class='lineno'>181 </a><span class='linecont'> (format nil "~a~@[.~a~]" ,name ,type)))))))</span></span><br /><span class='line' id='L182'><a href='#L182' class='lineno'>182 </a><span class='linecont'></span></span><br /><span class='line' id='L183'><a href='#L183' class='lineno'>183 </a><span class='linecont'>;; and to directories.</span></span><br /><span class='line' id='L184'><a href='#L184' class='lineno'>184 </a><span class='linecont'>(defmacro tcp-directory-link (pathspec &key (uri-prefix #p"/")</span></span><br /><span class='line' id='L185'><a href='#L185' class='lineno'>185 </a><span class='linecont'> custom-name)</span></span><br /><span class='line' id='L186'><a href='#L186' class='lineno'>186 </a><span class='linecont'> `(cl-who:htm</span></span><br /><span class='line' id='L187'><a href='#L187' class='lineno'>187 </a><span class='linecont'> (:em (cl-who:str "[d] "))</span></span><br /><span class='line' id='L188'><a href='#L188' class='lineno'>188 </a><span class='linecont'> (:a :class "dirlink"</span></span><br /><span class='line' id='L189'><a href='#L189' class='lineno'>189 </a><span class='linecont'> :href (namestring (concatenate-pathname-dirs ,uri-prefix ,pathspec))</span></span><br /><span class='line' id='L190'><a href='#L190' class='lineno'>190 </a><span class='linecont'> (cl-who:esc (or ,custom-name</span></span><br /><span class='line' id='L191'><a href='#L191' class='lineno'>191 </a><span class='linecont'> (car (last (pathname-directory ,pathspec))))))))</span></span><br /><span class='line' id='L192'><a href='#L192' class='lineno'>192 </a><span class='linecont'></span></span><br /><span class='line' id='L193'><a href='#L193' class='lineno'>193 </a><span class='linecont'>(defun parent-dir (pathspec)</span></span><br /><span class='line' id='L194'><a href='#L194' class='lineno'>194 </a><span class='linecont'> "Given PATHSPEC to directory, get parent node, e.g.:</span></span><br /><span class='line' id='L195'><a href='#L195' class='lineno'>195 </a><span class='linecont'></span></span><br /><span class='line' id='L196'><a href='#L196' class='lineno'>196 </a><span class='linecont'>- /home/bubu/ -> /home/</span></span><br /><span class='line' id='L197'><a href='#L197' class='lineno'>197 </a><span class='linecont'>- / -> /</span></span><br /><span class='line' id='L198'><a href='#L198' class='lineno'>198 </a><span class='linecont'></span></span><br /><span class='line' id='L199'><a href='#L199' class='lineno'>199 </a><span class='linecont'>Only the DIRECTORY component of PATHSPEC is considered, all others are</span></span><br /><span class='line' id='L200'><a href='#L200' class='lineno'>200 </a><span class='linecont'>ignored."</span></span><br /><span class='line' id='L201'><a href='#L201' class='lineno'>201 </a><span class='linecont'> (labels ((all-but-last (L)</span></span><br /><span class='line' id='L202'><a href='#L202' class='lineno'>202 </a><span class='linecont'> (cond</span></span><br /><span class='line' id='L203'><a href='#L203' class='lineno'>203 </a><span class='linecont'> ((null L) (error "Empty list."))</span></span><br /><span class='line' id='L204'><a href='#L204' class='lineno'>204 </a><span class='linecont'> (t (loop for curr-L on L</span></span><br /><span class='line' id='L205'><a href='#L205' class='lineno'>205 </a><span class='linecont'> while (cdr curr-L)</span></span><br /><span class='line' id='L206'><a href='#L206' class='lineno'>206 </a><span class='linecont'> collect (car curr-L))))))</span></span><br /><span class='line' id='L207'><a href='#L207' class='lineno'>207 </a><span class='linecont'> (let ((dir (pathname-directory pathspec)))</span></span><br /><span class='line' id='L208'><a href='#L208' class='lineno'>208 </a><span class='linecont'> (make-pathname :directory</span></span><br /><span class='line' id='L209'><a href='#L209' class='lineno'>209 </a><span class='linecont'> (if (null (cdr dir))</span></span><br /><span class='line' id='L210'><a href='#L210' class='lineno'>210 </a><span class='linecont'> dir</span></span><br /><span class='line' id='L211'><a href='#L211' class='lineno'>211 </a><span class='linecont'> (all-but-last dir))))))</span></span><br /><span class='line' id='L212'><a href='#L212' class='lineno'>212 </a><span class='linecont'></span></span><br /><span class='line' id='L213'><a href='#L213' class='lineno'>213 </a><span class='linecont'>;; Generate an index for a given directory.</span></span><br /><span class='line' id='L214'><a href='#L214' class='lineno'>214 </a><span class='linecont'>(defmacro tcp-index (tree &optional (uri-prefix #p"/"))</span></span><br /><span class='line' id='L215'><a href='#L215' class='lineno'>215 </a><span class='linecont'> (with-gensyms (parent-pathspec curr-pathspec children subtree)</span></span><br /><span class='line' id='L216'><a href='#L216' class='lineno'>216 </a><span class='linecont'> `(let* ((,curr-pathspec (car ,tree))</span></span><br /><span class='line' id='L217'><a href='#L217' class='lineno'>217 </a><span class='linecont'> (,children (cdr ,tree))</span></span><br /><span class='line' id='L218'><a href='#L218' class='lineno'>218 </a><span class='linecont'> (,parent-pathspec (parent-dir ,curr-pathspec)))</span></span><br /><span class='line' id='L219'><a href='#L219' class='lineno'>219 </a><span class='linecont'> (cl-who:htm</span></span><br /><span class='line' id='L220'><a href='#L220' class='lineno'>220 </a><span class='linecont'> (:pre :class "coadblock"</span></span><br /><span class='line' id='L221'><a href='#L221' class='lineno'>221 </a><span class='linecont'> ;; First link is self</span></span><br /><span class='line' id='L222'><a href='#L222' class='lineno'>222 </a><span class='linecont'> (tcp-directory-link ,curr-pathspec</span></span><br /><span class='line' id='L223'><a href='#L223' class='lineno'>223 </a><span class='linecont'> :uri-prefix ,uri-prefix</span></span><br /><span class='line' id='L224'><a href='#L224' class='lineno'>224 </a><span class='linecont'> :custom-name ".")</span></span><br /><span class='line' id='L225'><a href='#L225' class='lineno'>225 </a><span class='linecont'> (:br)</span></span><br /><span class='line' id='L226'><a href='#L226' class='lineno'>226 </a><span class='linecont'> ;; Second link is the parent</span></span><br /><span class='line' id='L227'><a href='#L227' class='lineno'>227 </a><span class='linecont'> (tcp-directory-link ,parent-pathspec</span></span><br /><span class='line' id='L228'><a href='#L228' class='lineno'>228 </a><span class='linecont'> :uri-prefix ,uri-prefix</span></span><br /><span class='line' id='L229'><a href='#L229' class='lineno'>229 </a><span class='linecont'> :custom-name"..")</span></span><br /><span class='line' id='L230'><a href='#L230' class='lineno'>230 </a><span class='linecont'> (:br)</span></span><br /><span class='line' id='L231'><a href='#L231' class='lineno'>231 </a><span class='linecont'></span></span><br /><span class='line' id='L232'><a href='#L232' class='lineno'>232 </a><span class='linecont'> ;; All the others are the files/subdirectories</span></span><br /><span class='line' id='L233'><a href='#L233' class='lineno'>233 </a><span class='linecont'> (loop for ,subtree in ,children do</span></span><br /><span class='line' id='L234'><a href='#L234' class='lineno'>234 </a><span class='linecont'> (cond</span></span><br /><span class='line' id='L235'><a href='#L235' class='lineno'>235 </a><span class='linecont'> ((pathnamep ,subtree) (tcp-file-link</span></span><br /><span class='line' id='L236'><a href='#L236' class='lineno'>236 </a><span class='linecont'> ,curr-pathspec</span></span><br /><span class='line' id='L237'><a href='#L237' class='lineno'>237 </a><span class='linecont'> ,subtree</span></span><br /><span class='line' id='L238'><a href='#L238' class='lineno'>238 </a><span class='linecont'> :uri-prefix ,uri-prefix))</span></span><br /><span class='line' id='L239'><a href='#L239' class='lineno'>239 </a><span class='linecont'> ((listp ,subtree) (tcp-directory-link</span></span><br /><span class='line' id='L240'><a href='#L240' class='lineno'>240 </a><span class='linecont'> (car ,subtree)</span></span><br /><span class='line' id='L241'><a href='#L241' class='lineno'>241 </a><span class='linecont'> :uri-prefix ,uri-prefix))</span></span><br /><span class='line' id='L242'><a href='#L242' class='lineno'>242 </a><span class='linecont'> (t (error "Not a tree.")))</span></span><br /><span class='line' id='L243'><a href='#L243' class='lineno'>243 </a><span class='linecont'> (cl-who:htm (:br))))))))</span></span><br /><span class='line' id='L244'><a href='#L244' class='lineno'>244 </a><span class='linecont'></span></span><br /><span class='line' id='L245'><a href='#L245' class='lineno'>245 </a><span class='linecont'>;; To generate HTML pages for a given codebase, we need the following</span></span><br /><span class='line' id='L246'><a href='#L246' class='lineno'>246 </a><span class='linecont'>;; information:</span></span><br /><span class='line' id='L247'><a href='#L247' class='lineno'>247 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L248'><a href='#L248' class='lineno'>248 </a><span class='linecont'>;; - the (relative, normalized) path information for all the files;</span></span><br /><span class='line' id='L249'><a href='#L249' class='lineno'>249 </a><span class='linecont'>;; - an optional URI prefix for hrefs residing downstream in the site;</span></span><br /><span class='line' id='L250'><a href='#L250' class='lineno'>250 </a><span class='linecont'>;; - the path to the root of the input directory; and</span></span><br /><span class='line' id='L251'><a href='#L251' class='lineno'>251 </a><span class='linecont'>;; - the path to the root of the output directory.</span></span><br /><span class='line' id='L252'><a href='#L252' class='lineno'>252 </a><span class='linecont'>;;</span></span><br /><span class='line' id='L253'><a href='#L253' class='lineno'>253 </a><span class='linecont'>;; We capture those in the tcp-info struct:</span></span><br /><span class='line' id='L254'><a href='#L254' class='lineno'>254 </a><span class='linecont'>(defstruct (tcp-info (:constructor make-tcp-info%))</span></span><br /><span class='line' id='L255'><a href='#L255' class='lineno'>255 </a><span class='linecont'> in-pathspec out-pathspec uri-prefix tree)</span></span><br /><span class='line' id='L256'><a href='#L256' class='lineno'>256 </a><span class='linecont'></span></span><br /><span class='line' id='L257'><a href='#L257' class='lineno'>257 </a><span class='linecont'>(defun make-tcp-info (in-pathspec out-pathspec &optional (uri-prefix #p"/"))</span></span><br /><span class='line' id='L258'><a href='#L258' class='lineno'>258 </a><span class='linecont'> "Create info structre for HTML coadpage generation."</span></span><br /><span class='line' id='L259'><a href='#L259' class='lineno'>259 </a><span class='linecont'> (let ((in-tree (extract-tree in-pathspec)))</span></span><br /><span class='line' id='L260'><a href='#L260' class='lineno'>260 </a><span class='linecont'> (make-tcp-info% :in-pathspec in-pathspec</span></span><br /><span class='line' id='L261'><a href='#L261' class='lineno'>261 </a><span class='linecont'> :out-pathspec out-pathspec</span></span><br /><span class='line' id='L262'><a href='#L262' class='lineno'>262 </a><span class='linecont'> :uri-prefix uri-prefix</span></span><br /><span class='line' id='L263'><a href='#L263' class='lineno'>263 </a><span class='linecont'> :tree (normalized-tree in-tree))))</span></span><br /><span class='line' id='L264'><a href='#L264' class='lineno'>264 </a><span class='linecont'></span></span><br /><span class='line' id='L265'><a href='#L265' class='lineno'>265 </a><span class='linecont'>;; Write index page, using all the above helpers.</span></span><br /><span class='line' id='L266'><a href='#L266' class='lineno'>266 </a><span class='linecont'>(defun write-index-page (tree tcp-info)</span></span><br /><span class='line' id='L267'><a href='#L267' class='lineno'>267 </a><span class='linecont'> "Write TREE to HTML file given by OUT-PATHSPEC in TCP-INFO."</span></span><br /><span class='line' id='L268'><a href='#L268' class='lineno'>268 </a><span class='linecont'> ;; Do nothing if TREE is a regular file.</span></span><br /><span class='line' id='L269'><a href='#L269' class='lineno'>269 </a><span class='linecont'> (when (pathnamep tree)</span></span><br /><span class='line' id='L270'><a href='#L270' class='lineno'>270 </a><span class='linecont'> (return-from write-index-page))</span></span><br /><span class='line' id='L271'><a href='#L271' class='lineno'>271 </a><span class='linecont'></span></span><br /><span class='line' id='L272'><a href='#L272' class='lineno'>272 </a><span class='linecont'> ;; Do something only if we have a subtree.</span></span><br /><span class='line' id='L273'><a href='#L273' class='lineno'>273 </a><span class='linecont'> (assert (listp tree))</span></span><br /><span class='line' id='L274'><a href='#L274' class='lineno'>274 </a><span class='linecont'> (let ((out-path (merge-pathnames</span></span><br /><span class='line' id='L275'><a href='#L275' class='lineno'>275 </a><span class='linecont'> (concatenate-pathname-dirs (tcp-info-out-pathspec tcp-info)</span></span><br /><span class='line' id='L276'><a href='#L276' class='lineno'>276 </a><span class='linecont'> (car tree))</span></span><br /><span class='line' id='L277'><a href='#L277' class='lineno'>277 </a><span class='linecont'> "index.html"))</span></span><br /><span class='line' id='L278'><a href='#L278' class='lineno'>278 </a><span class='linecont'> (title (format nil "Index for ~a:" (namestring (car tree)))))</span></span><br /><span class='line' id='L279'><a href='#L279' class='lineno'>279 </a><span class='linecont'> (with-open-file (out out-path</span></span><br /><span class='line' id='L280'><a href='#L280' class='lineno'>280 </a><span class='linecont'> :direction :output</span></span><br /><span class='line' id='L281'><a href='#L281' class='lineno'>281 </a><span class='linecont'> :if-exists :supersede</span></span><br /><span class='line' id='L282'><a href='#L282' class='lineno'>282 </a><span class='linecont'> :if-does-not-exist :create)</span></span><br /><span class='line' id='L283'><a href='#L283' class='lineno'>283 </a><span class='linecont'> (cl-who:with-html-output (out nil</span></span><br /><span class='line' id='L284'><a href='#L284' class='lineno'>284 </a><span class='linecont'> :prologue t</span></span><br /><span class='line' id='L285'><a href='#L285' class='lineno'>285 </a><span class='linecont'> :indent nil)</span></span><br /><span class='line' id='L286'><a href='#L286' class='lineno'>286 </a><span class='linecont'> (cl-who:htm</span></span><br /><span class='line' id='L287'><a href='#L287' class='lineno'>287 </a><span class='linecont'> (:html (:head (tcp-html-header title))</span></span><br /><span class='line' id='L288'><a href='#L288' class='lineno'>288 </a><span class='linecont'> (:body (:b (cl-who:str title))</span></span><br /><span class='line' id='L289'><a href='#L289' class='lineno'>289 </a><span class='linecont'> (tcp-index tree (tcp-info-uri-prefix tcp-info)))))))))</span></span><br /><span class='line' id='L290'><a href='#L290' class='lineno'>290 </a><span class='linecont'></span></span><br /><span class='line' id='L291'><a href='#L291' class='lineno'>291 </a><span class='linecont'>;; Now we have the basic ammo to generate everything.</span></span><br /><span class='line' id='L292'><a href='#L292' class='lineno'>292 </a><span class='linecont'>(defun generate-coad-pit (tcp-info)</span></span><br /><span class='line' id='L293'><a href='#L293' class='lineno'>293 </a><span class='linecont'> "Given TCP-INFO, generate code site."</span></span><br /><span class='line' id='L294'><a href='#L294' class='lineno'>294 </a><span class='linecont'> (labels</span></span><br /><span class='line' id='L295'><a href='#L295' class='lineno'>295 </a><span class='linecont'> ((recurse (tree parent-pathspec)</span></span><br /><span class='line' id='L296'><a href='#L296' class='lineno'>296 </a><span class='linecont'> ;; Are we on a leaf, or...?</span></span><br /><span class='line' id='L297'><a href='#L297' class='lineno'>297 </a><span class='linecont'> (cond</span></span><br /><span class='line' id='L298'><a href='#L298' class='lineno'>298 </a><span class='linecont'> ;; Read lines and generate code page. Careful, if you're</span></span><br /><span class='line' id='L299'><a href='#L299' class='lineno'>299 </a><span class='linecont'> ;; reading from binary files, you're fucked.</span></span><br /><span class='line' id='L300'><a href='#L300' class='lineno'>300 </a><span class='linecont'> ((pathnamep tree)</span></span><br /><span class='line' id='L301'><a href='#L301' class='lineno'>301 </a><span class='linecont'> (let* ((dir (pathname-directory tree))</span></span><br /><span class='line' id='L302'><a href='#L302' class='lineno'>302 </a><span class='linecont'> (name (pathname-name tree))</span></span><br /><span class='line' id='L303'><a href='#L303' class='lineno'>303 </a><span class='linecont'> (type (pathname-type tree))</span></span><br /><span class='line' id='L304'><a href='#L304' class='lineno'>304 </a><span class='linecont'> (htm-pathspec (tcp-html-path dir name type))</span></span><br /><span class='line' id='L305'><a href='#L305' class='lineno'>305 </a><span class='linecont'> (in-pathspec</span></span><br /><span class='line' id='L306'><a href='#L306' class='lineno'>306 </a><span class='linecont'> (concatenate-pathname-dirs (tcp-info-in-pathspec tcp-info)</span></span><br /><span class='line' id='L307'><a href='#L307' class='lineno'>307 </a><span class='linecont'> (merge-pathnames parent-pathspec</span></span><br /><span class='line' id='L308'><a href='#L308' class='lineno'>308 </a><span class='linecont'> tree)))</span></span><br /><span class='line' id='L309'><a href='#L309' class='lineno'>309 </a><span class='linecont'> (out-pathspec</span></span><br /><span class='line' id='L310'><a href='#L310' class='lineno'>310 </a><span class='linecont'> (concatenate-pathname-dirs (tcp-info-out-pathspec tcp-info)</span></span><br /><span class='line' id='L311'><a href='#L311' class='lineno'>311 </a><span class='linecont'> (merge-pathnames parent-pathspec</span></span><br /><span class='line' id='L312'><a href='#L312' class='lineno'>312 </a><span class='linecont'> htm-pathspec)))</span></span><br /><span class='line' id='L313'><a href='#L313' class='lineno'>313 </a><span class='linecont'> (title (namestring tree))</span></span><br /><span class='line' id='L314'><a href='#L314' class='lineno'>314 </a><span class='linecont'> (lines (read-file-lines in-pathspec)))</span></span><br /><span class='line' id='L315'><a href='#L315' class='lineno'>315 </a><span class='linecont'> (write-code-page title lines out-pathspec)))</span></span><br /><span class='line' id='L316'><a href='#L316' class='lineno'>316 </a><span class='linecont'> ((listp tree)</span></span><br /><span class='line' id='L317'><a href='#L317' class='lineno'>317 </a><span class='linecont'> (let* ((pathspec (car tree))</span></span><br /><span class='line' id='L318'><a href='#L318' class='lineno'>318 </a><span class='linecont'> (children (cdr tree))</span></span><br /><span class='line' id='L319'><a href='#L319' class='lineno'>319 </a><span class='linecont'> (out-pathspec</span></span><br /><span class='line' id='L320'><a href='#L320' class='lineno'>320 </a><span class='linecont'> (concatenate-pathname-dirs (tcp-info-out-pathspec tcp-info)</span></span><br /><span class='line' id='L321'><a href='#L321' class='lineno'>321 </a><span class='linecont'> pathspec)))</span></span><br /><span class='line' id='L322'><a href='#L322' class='lineno'>322 </a><span class='linecont'> (ensure-directories-exist out-pathspec)</span></span><br /><span class='line' id='L323'><a href='#L323' class='lineno'>323 </a><span class='linecont'> (write-index-page tree tcp-info)</span></span><br /><span class='line' id='L324'><a href='#L324' class='lineno'>324 </a><span class='linecont'> (loop for subtree in children do</span></span><br /><span class='line' id='L325'><a href='#L325' class='lineno'>325 </a><span class='linecont'> (recurse subtree pathspec))))</span></span><br /><span class='line' id='L326'><a href='#L326' class='lineno'>326 </a><span class='linecont'> (t (error "Not a tree.")))))</span></span><br /><span class='line' id='L327'><a href='#L327' class='lineno'>327 </a><span class='linecont'> (recurse (tcp-info-tree tcp-info) #p"/")))</span></span><br /></pre></body></html>
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html><head><title>prelude.lisp</title><style type='text/css'>
+.coadblock {background-color:#e8e8e8;
+ border-style:solid;border-width:1px;padding-left:5px;}
+.line {float:left; width:100%;}
+.lineno {font-weight:bold;text-decoration:none;color:black;}
+.lineno:visited {color:black;}
+:target {background-color:lightyellow;}</style></head><body><b>prelude.lisp</b><pre class='coadblock'><span class='line' id='L1'><a href='#L1' class='lineno'> 1 </a><span class='linecont'>;; CL-WHO demo, a prelude</span></span><br /><span class='line' id='L2'><a href='#L2' class='lineno'> 2 </a><span class='linecont'>(require 'asdf)</span></span><br /><span class='line' id='L3'><a href='#L3' class='lineno'> 3 </a><span class='linecont'></span></span><br /><span class='line' id='L4'><a href='#L4' class='lineno'> 4 </a><span class='linecont'>;; Change this to whatever helps you import CL-WHO.</span></span><br /><span class='line' id='L5'><a href='#L5' class='lineno'> 5 </a><span class='linecont'>(defvar *stolen* "/home/stolen/")</span></span><br /><span class='line' id='L6'><a href='#L6' class='lineno'> 6 </a><span class='linecont'>(pushnew (concatenate 'string</span></span><br /><span class='line' id='L7'><a href='#L7' class='lineno'> 7 </a><span class='linecont'> *stolen* "cl-who/")</span></span><br /><span class='line' id='L8'><a href='#L8' class='lineno'> 8 </a><span class='linecont'> asdf:*central-registry*</span></span><br /><span class='line' id='L9'><a href='#L9' class='lineno'> 9 </a><span class='linecont'> :test #'string=)</span></span><br /><span class='line' id='L10'><a href='#L10' class='lineno'>10 </a><span class='linecont'>(asdf:load-system :cl-who)</span></span><br /><span class='line' id='L11'><a href='#L11' class='lineno'>11 </a><span class='linecont'></span></span><br /><span class='line' id='L12'><a href='#L12' class='lineno'>12 </a><span class='linecont'>;; Below goes whatever example code you may wish to test:</span></span><br /></pre></body></html>
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html><head><title>placeholder</title><style type='text/css'>
+.coadblock {background-color:#e8e8e8;
+ border-style:solid;border-width:1px;padding-left:5px;}
+.line {float:left; width:100%;}
+.lineno {font-weight:bold;text-decoration:none;color:black;}
+.lineno:visited {color:black;}
+:target {background-color:lightyellow;}</style></head><body><b>placeholder</b><pre class='coadblock'><span class='line' id='L1'><a href='#L1' class='lineno'>1 </a><span class='linecont'>this is where we put files in a subdirectory.</span></span><br /></pre></body></html>
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html><head><title>Index for /demo-dir/:</title><style type='text/css'>
+.coadblock {background-color:#e8e8e8;
+ border-style:solid;border-width:1px;padding-left:5px;}
+.line {float:left; width:100%;}
+.lineno {font-weight:bold;text-decoration:none;color:black;}
+.lineno:visited {color:black;}
+:target {background-color:lightyellow;}</style></head><body><b>Index for /demo-dir/:</b><pre class='coadblock'><em>[d] </em><a class='dirlink' href='/uploads/2019/07/cl-who-demo/demo-dir/'>.</a><br /><em>[d] </em><a class='dirlink' href='/uploads/2019/07/cl-who-demo/'>..</a><br /><em>[f] </em><a class='filelink' href='/uploads/2019/07/cl-who-demo/demo-dir/c-placeholder.html'>placeholder</a><br /></pre></body></html>
\ No newline at end of file
--- /dev/null
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html><head><title>Index for /:</title><style type='text/css'>
+.coadblock {background-color:#e8e8e8;
+ border-style:solid;border-width:1px;padding-left:5px;}
+.line {float:left; width:100%;}
+.lineno {font-weight:bold;text-decoration:none;color:black;}
+.lineno:visited {color:black;}
+:target {background-color:lightyellow;}</style></head><body><b>Index for /:</b><pre class='coadblock'><em>[d] </em><a class='dirlink' href='/uploads/2019/07/cl-who-demo/'>.</a><br /><em>[d] </em><a class='dirlink' href='/uploads/2019/07/cl-who-demo/'>..</a><br /><em>[d] </em><a class='dirlink' href='/uploads/2019/07/cl-who-demo/demo-dir/'>demo-dir</a><br /><em>[f] </em><a class='filelink' href='/uploads/2019/07/cl-who-demo/c-demo.lisp.html'>demo.lisp</a><br /><em>[f] </em><a class='filelink' href='/uploads/2019/07/cl-who-demo/c-prelude.lisp.html'>prelude.lisp</a><br /></pre></body></html>
\ No newline at end of file
projects / thetarpit.git / commitdiff