From 3f1ca19a3c3547c688f49800dcbfc47636fd90e6 Mon Sep 17 00:00:00 2001 From: Lucian Mogosanu Date: Fri, 5 Jul 2019 18:00:31 +0300 Subject: [PATCH] posts: 095 --- drafts/000-cl-who-ii.markdown | 230 ------------------- posts/y05/095-cl-who-ii.markdown | 231 ++++++++++++++++++++ uploads/2019/07/cl-who-demo/c-demo.lisp.html | 8 + uploads/2019/07/cl-who-demo/c-prelude.lisp.html | 8 + .../07/cl-who-demo/demo-dir/c-placeholder.html | 8 + uploads/2019/07/cl-who-demo/demo-dir/index.html | 8 + uploads/2019/07/cl-who-demo/index.html | 8 + 7 files changed, 271 insertions(+), 230 deletions(-) delete mode 100644 drafts/000-cl-who-ii.markdown create mode 100644 posts/y05/095-cl-who-ii.markdown create mode 100644 uploads/2019/07/cl-who-demo/c-demo.lisp.html create mode 100644 uploads/2019/07/cl-who-demo/c-prelude.lisp.html create mode 100644 uploads/2019/07/cl-who-demo/demo-dir/c-placeholder.html create mode 100644 uploads/2019/07/cl-who-demo/demo-dir/index.html create mode 100644 uploads/2019/07/cl-who-demo/index.html diff --git a/drafts/000-cl-who-ii.markdown b/drafts/000-cl-who-ii.markdown deleted file mode 100644 index 58d1bf8..0000000 --- a/drafts/000-cl-who-ii.markdown +++ /dev/null @@ -1,230 +0,0 @@ ---- -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: - -~~~~ -Hello, world! -~~~~ - -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: - -~~~~ - -~~~~ - -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/ diff --git a/posts/y05/095-cl-who-ii.markdown b/posts/y05/095-cl-who-ii.markdown new file mode 100644 index 0000000..24f9734 --- /dev/null +++ b/posts/y05/095-cl-who-ii.markdown @@ -0,0 +1,231 @@ +--- +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: + +~~~~ +Hello, world! +~~~~ + +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: + +~~~~ + +~~~~ + +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/ diff --git a/uploads/2019/07/cl-who-demo/c-demo.lisp.html b/uploads/2019/07/cl-who-demo/c-demo.lisp.html new file mode 100644 index 0000000..0d23961 --- /dev/null +++ b/uploads/2019/07/cl-who-demo/c-demo.lisp.html @@ -0,0 +1,8 @@ + +demo.lispdemo.lisp
  1 ;; CL-WHO demo: The Coad Pit (TCP).
  2 
  3 ;; Utilities:
  4 (defmacro with-gensyms ((&rest names) &body body)
  5   `(let ,(loop for n in names collect `(,n (gensym)))
  6      ,@body))
  7 
  8 (defun concatenate-pathname-dirs (pathname1 pathname2)
  9   "The result will be a file with the directories of PATHNAME1 and
 10 PATHNAME2 concatenated.
 11 
 12 File names and types of PATHNAMEs are ignored."
 13   (let ((dir1 (pathname-directory pathname1))
 14 	(dir2 (pathname-directory pathname2)))
 15     (make-pathname :directory
 16 		   (append dir1 (cdr dir2))
 17 		   :name (pathname-name pathname2)
 18 		   :type (pathname-type pathname2))))
 19 
 20 (defun read-file-lines (pathspec)
 21   "Read lines in file pointed to by PATHSPEC one by one and return
 22 them in a list."
 23   (with-open-file (in pathspec)
 24     (loop for line = (read-line in nil :eof)
 25 	 until (eq line :eof)
 26 	 collect line)))
 27 
 28 ;; Part one: code page generation
 29 
 30 ;; A line has two components: a number and its content.
 31 (defmacro tcp-line-number (n &optional (padding 0))
 32   "Template for the line number."
 33   `(cl-who:str (format nil "~vd " ,padding ,n)))
 34 
 35 (defmacro tcp-line-content (line)
 36   "Template for the line content."
 37   `(cl-who:esc ,line))
 38 
 39 (defmacro tcp-line (number padding content)
 40   "Template for the line."
 41   `(cl-who:htm
 42     (:span :class "line"
 43 	   :id (format nil "L~d" ,number)
 44 	   (:a :href  (format nil "#L~d" ,number)
 45 	       :class "lineno"
 46 	       (tcp-line-number ,number ,padding))
 47 	   (:span :class "linecont"
 48 		  (tcp-line-content ,content)))
 49     (:br)))
 50 
 51 ;; A code block is a list of lines.
 52 (defmacro tcp-block (lines)
 53   "Template for generating a code block out of a list of lines."
 54   (with-gensyms (i padding line)
 55    `(cl-who:htm
 56      (:pre :class "coadblock"
 57       (loop for ,padding = (length (format nil "~d" (length ,lines)))
 58 	 for ,i = 1 then (1+ ,i)
 59 	 for ,line in ,lines do
 60 	   (tcp-line ,i ,padding ,line))))))
 61 
 62 ;; The header contains a title and some CSS.
 63 (defmacro tcp-html-header (title)
 64   `(cl-who:htm
 65     (:title (cl-who:str ,title))
 66     (:style :type "text/css"
 67 	    (cl-who:str "
 68 .coadblock {background-color:#e8e8e8;
 69             border-style:solid;border-width:1px;padding-left:5px;}
 70 .line {float:left; width:100%;}
 71 .lineno {font-weight:bold;text-decoration:none;color:black;}
 72 .lineno:visited {color:black;}
 73 :target {background-color:lightyellow;}"))))
 74 
 75 ;; Print this to output file.
 76 (defun write-code-page (title lines out-path)
 77   "Write LINES to OUT-PATH as a HTML file."
 78   (with-open-file (out out-path
 79 		       :direction :output
 80 		       :if-exists :supersede)
 81     (cl-who:with-html-output (out nil
 82 				  :prologue t
 83 				  :indent nil)
 84       (cl-who:htm
 85        (:html (:head (tcp-html-header title))
 86 	      (:body (:b (cl-who:str title))
 87 		     (tcp-block lines)))))))
 88 
 89 ;; Example:
 90 ;;
 91 ;; (lines-to-file
 92 ;; 	  "A Testes"
 93 ;; 	  (loop for i from 1 to 20 collect (format nil "line ~d" i))
 94 ;; 	  "/virtual/sites/lucian.mogosanu.ro/randomio/test-who.html")
 95 
 96 ;; Part two: code tree processing
 97 ;;
 98 ;; We need to:
 99 ;;
100 ;; - turn filesystem paths into a walkable tree format;
101 ;;
102 ;; - for each directory, be able to generate an index file containing
103 ;;   links to files and subdirectories; and
104 ;;
105 ;; - walk said tree and generate code and index pages.
106 
107 ;; A tree is one of the following two things:
108 ;;
109 ;; - a pathname with the NAME set to a string; or
110 ;;
111 ;; - a list whose first element is a pathname with the DIRECTORY set
112 ;;   to a path and the NAME is not set; the other list elements are
113 ;;   trees.
114 ;;
115 ;; For example: (#p"/" #p"a" (#p"/dir/" #p"b" #p"c") #p"d")
116 
117 (defun extract-tree (pathspec)
118   "Recursively extract a tree from PATHSPEC."
119 
120   ;; If PATHSPEC is not a pathname, turn it into one.
121   (when (stringp pathspec)
122     (setq pathspec (pathname pathspec)))
123 
124   ;; Determine the type of node we're dealing with
125   (let ((dir (pathname-directory pathspec))
126 	(name (pathname-name pathspec))
127 	(type (pathname-type pathspec)))
128     (cond
129       (name (make-pathname :name name :type type))
130       (dir (let ((files (directory (make-pathname :directory dir
131 						  :name :wild
132 						  :type :wild))))
133 	     (cons pathspec
134 		   (mapcar #'extract-tree files)))))))
135 
136 (defun normalized-tree (tree)
137   "Normalize TREE by removing the common part of the path in all
138 directories.
139 
140 This function assumes TREE was obtained using EXTRACT-TREE."
141   (let ((root-pathspec (car tree)))
142     (labels ((recurse (tree)
143 	       ;; This doesn't do anything for non-directory files.
144 	       (when (pathnamep tree)
145 		 (return-from recurse tree))
146 	       (let ((dircopy (copy-list
147 			       (pathname-directory root-pathspec)))
148 		     (curr-dir (pathname-directory (car tree))))
149 		 ;; Get rid of common parts...
150 		 (loop until (null dircopy) do
151 		      (pop dircopy)
152 		      (pop curr-dir))
153 		 ;; Set normalized path
154 		 (push :absolute curr-dir)
155 		 ;; Now recurse into the rest of the tree
156 		 (cons (make-pathname :directory curr-dir)
157 		       (mapcar #'(lambda (tree)
158 				   (recurse tree))
159 			       (cdr tree))))))
160       (recurse tree))))
161 
162 (defmacro tcp-html-path (dir name type)
163   `(make-pathname :directory ,dir
164 		  :name (format nil "c-~a~@[.~a~]" ,name ,type)
165 		  :type "html"))
166 
167 ;; Links to files...
168 (defmacro tcp-file-link (parent-pathspec pathspec &key (uri-prefix #p"/"))
169   (with-gensyms (dir name type)
170     `(let ((,dir (pathname-directory ,parent-pathspec))
171 	   (,name (pathname-name ,pathspec))
172 	   (,type (pathname-type ,pathspec)))
173        (cl-who:htm
174 	(:em (cl-who:str "[f] "))
175 	(:a :class "filelink"
176 	    :href (namestring (merge-pathnames
177 			       (concatenate-pathname-dirs ,uri-prefix
178 							  ,parent-pathspec)
179 			       (tcp-html-path ,dir ,name, type)))
180 	    (cl-who:esc
181 	     (format nil "~a~@[.~a~]" ,name ,type)))))))
182 
183 ;; and to directories.
184 (defmacro tcp-directory-link (pathspec &key (uri-prefix #p"/")
185 			                    custom-name)
186   `(cl-who:htm
187     (:em (cl-who:str "[d] "))
188     (:a :class "dirlink"
189 	:href (namestring (concatenate-pathname-dirs ,uri-prefix ,pathspec))
190 	(cl-who:esc (or ,custom-name
191 			(car (last (pathname-directory ,pathspec))))))))
192 
193 (defun parent-dir (pathspec)
194   "Given PATHSPEC to directory, get parent node, e.g.:
195 
196 - /home/bubu/ -> /home/
197 - /           -> /
198 
199 Only the DIRECTORY component of PATHSPEC is considered, all others are
200 ignored."
201   (labels ((all-but-last (L)
202 	     (cond
203 	       ((null L) (error "Empty list."))
204 	       (t (loop for curr-L on L
205 		     while (cdr curr-L)
206 		     collect (car curr-L))))))
207    (let ((dir (pathname-directory pathspec)))
208      (make-pathname :directory
209 		    (if (null (cdr dir))
210 			dir
211 			(all-but-last dir))))))
212 
213 ;; Generate an index for a given directory.
214 (defmacro tcp-index (tree &optional (uri-prefix #p"/"))
215   (with-gensyms (parent-pathspec curr-pathspec children subtree)
216     `(let* ((,curr-pathspec (car ,tree))
217 	    (,children (cdr ,tree))
218 	    (,parent-pathspec (parent-dir ,curr-pathspec)))
219        (cl-who:htm
220 	(:pre :class "coadblock"
221 	      ;; First link is self
222 	      (tcp-directory-link ,curr-pathspec
223 				  :uri-prefix ,uri-prefix
224 				  :custom-name ".")
225 	      (:br)
226 	      ;; Second link is the parent
227 	      (tcp-directory-link ,parent-pathspec
228 				  :uri-prefix ,uri-prefix
229 				  :custom-name"..")
230 	      (:br)
231 
232 	      ;; All the others are the files/subdirectories
233 	      (loop for ,subtree in ,children do
234 		   (cond
235 		     ((pathnamep ,subtree) (tcp-file-link
236 					    ,curr-pathspec
237 					    ,subtree
238 					    :uri-prefix ,uri-prefix))
239 		     ((listp ,subtree) (tcp-directory-link
240 					(car ,subtree)
241 					:uri-prefix ,uri-prefix))
242 		     (t (error "Not a tree.")))
243 		   (cl-who:htm (:br))))))))
244 
245 ;; To generate HTML pages for a given codebase, we need the following
246 ;; information:
247 ;;
248 ;; - the (relative, normalized) path information for all the files;
249 ;; - an optional URI prefix for hrefs residing downstream in the site;
250 ;; - the path to the root of the input directory; and
251 ;; - the path to the root of the output directory.
252 ;;
253 ;; We capture those in the tcp-info struct:
254 (defstruct (tcp-info (:constructor make-tcp-info%))
255   in-pathspec out-pathspec uri-prefix tree)
256 
257 (defun make-tcp-info (in-pathspec out-pathspec &optional (uri-prefix #p"/"))
258   "Create info structre for HTML coadpage generation."
259   (let ((in-tree (extract-tree in-pathspec)))
260    (make-tcp-info% :in-pathspec in-pathspec
261 		   :out-pathspec out-pathspec
262 		   :uri-prefix uri-prefix
263 		   :tree (normalized-tree in-tree))))
264 
265 ;; Write index page, using all the above helpers.
266 (defun write-index-page (tree tcp-info)
267   "Write TREE to HTML file given by OUT-PATHSPEC in TCP-INFO."
268   ;; Do nothing if TREE is a regular file.
269   (when (pathnamep tree)
270     (return-from write-index-page))
271 
272   ;; Do something only if we have a subtree.
273   (assert (listp tree))
274   (let ((out-path (merge-pathnames
275 		   (concatenate-pathname-dirs (tcp-info-out-pathspec tcp-info)
276 					      (car tree))
277 		   "index.html"))
278 	(title (format nil "Index for ~a:" (namestring (car tree)))))
279     (with-open-file (out out-path
280 			 :direction :output
281 			 :if-exists :supersede
282 			 :if-does-not-exist :create)
283       (cl-who:with-html-output (out nil
284 				    :prologue t
285 				    :indent nil)
286 	(cl-who:htm
287 	 (:html (:head (tcp-html-header title))
288 		(:body (:b (cl-who:str title))
289 		       (tcp-index tree (tcp-info-uri-prefix tcp-info)))))))))
290 
291 ;; Now we have the basic ammo to generate everything.
292 (defun generate-coad-pit (tcp-info)
293   "Given TCP-INFO, generate code site."
294   (labels
295       ((recurse (tree parent-pathspec)
296 	 ;; Are we on a leaf, or...?
297 	 (cond
298 	   ;; Read lines and generate code page. Careful, if you're
299 	   ;; reading from binary files, you're fucked.
300 	   ((pathnamep tree)
301 	    (let* ((dir (pathname-directory tree))
302 		   (name (pathname-name tree))
303 		   (type (pathname-type tree))
304 		   (htm-pathspec (tcp-html-path dir name type))
305 		   (in-pathspec
306 		    (concatenate-pathname-dirs (tcp-info-in-pathspec tcp-info)
307 					       (merge-pathnames parent-pathspec
308 								tree)))
309 		   (out-pathspec
310 		    (concatenate-pathname-dirs (tcp-info-out-pathspec tcp-info)
311 					       (merge-pathnames parent-pathspec
312 								htm-pathspec)))
313 		   (title (namestring tree))
314 		   (lines (read-file-lines in-pathspec)))
315 	      (write-code-page title lines out-pathspec)))
316 	   ((listp tree)
317 	    (let* ((pathspec (car tree))
318 		   (children (cdr tree))
319 		   (out-pathspec
320 		    (concatenate-pathname-dirs (tcp-info-out-pathspec tcp-info)
321 					       pathspec)))
322 	      (ensure-directories-exist out-pathspec)
323 	      (write-index-page tree tcp-info)
324 	      (loop for subtree in children do
325 		   (recurse subtree pathspec))))
326 	   (t (error "Not a tree.")))))
327     (recurse (tcp-info-tree tcp-info) #p"/")))
\ No newline at end of file diff --git a/uploads/2019/07/cl-who-demo/c-prelude.lisp.html b/uploads/2019/07/cl-who-demo/c-prelude.lisp.html new file mode 100644 index 0000000..9835f88 --- /dev/null +++ b/uploads/2019/07/cl-who-demo/c-prelude.lisp.html @@ -0,0 +1,8 @@ + +prelude.lispprelude.lisp
 1 ;; CL-WHO demo, a prelude
 2 (require 'asdf)
 3 
 4 ;; Change this to whatever helps you import CL-WHO.
 5 (defvar *stolen* "/home/stolen/")
 6 (pushnew (concatenate 'string
 7 		      *stolen* "cl-who/")
 8 	 asdf:*central-registry*
 9 	 :test #'string=)
10 (asdf:load-system :cl-who)
11 
12 ;; Below goes whatever example code you may wish to test:
\ No newline at end of file diff --git a/uploads/2019/07/cl-who-demo/demo-dir/c-placeholder.html b/uploads/2019/07/cl-who-demo/demo-dir/c-placeholder.html new file mode 100644 index 0000000..6cf8936 --- /dev/null +++ b/uploads/2019/07/cl-who-demo/demo-dir/c-placeholder.html @@ -0,0 +1,8 @@ + +placeholderplaceholder
1 this is where we put files in a subdirectory.
\ No newline at end of file diff --git a/uploads/2019/07/cl-who-demo/demo-dir/index.html b/uploads/2019/07/cl-who-demo/demo-dir/index.html new file mode 100644 index 0000000..c050678 --- /dev/null +++ b/uploads/2019/07/cl-who-demo/demo-dir/index.html @@ -0,0 +1,8 @@ + +Index for /demo-dir/:Index for /demo-dir/:
[d] .
[d] ..
[f] placeholder
\ No newline at end of file diff --git a/uploads/2019/07/cl-who-demo/index.html b/uploads/2019/07/cl-who-demo/index.html new file mode 100644 index 0000000..f7bc3d0 --- /dev/null +++ b/uploads/2019/07/cl-who-demo/index.html @@ -0,0 +1,8 @@ + +Index for /:Index for /:
[d] .
[d] ..
[d] demo-dir
[f] demo.lisp
[f] prelude.lisp
\ No newline at end of file -- 1.7.10.4