diff --git a/command-line.lisp b/command-line.lisp index 821ee5e..170e566 100644 --- a/command-line.lisp +++ b/command-line.lisp @@ -65,10 +65,10 @@ (when (getf options :help) (opts:describe - :prefix "Literate programming system. Write code to be read by humans, not machines." - :usage-of "srcweave" - :suffix "Created by Justin Meiners (2022)" - :args "LITFILE") + :prefix "Literate programming system. Write code to be read by humans, not machines." + :usage-of "srcweave" + :suffix "Created by Justin Meiners (2022)" + :args "LITFILE") (opts:exit 0)) (when (null free-args) @@ -90,13 +90,13 @@ (weave-path (getf options :weave)) (tangle-path (getf options :tangle))) - (when tangle-path + (when tangle-path (format t "TANGLE~%") (tangle (alexandria-2:mappend #'cdr file-defs) tangle-path :ignore-dates ignore-dates) - (format t "DONE~%")) + (format t "DONE~%")) (when weave-path (format t "WEAVE~%") (weave file-defs diff --git a/dev/dev.lit b/dev/dev.lit new file mode 100644 index 0000000..06db6e8 --- /dev/null +++ b/dev/dev.lit @@ -0,0 +1,46 @@ +# My test lit file + +Preamble + +@toc + +## Foobar + +Section 1: foobar. +What follows is foobar.lisp. + +--- /foobar.lisp +(+ 2 2) +@{foobaz} +--- + +## Foobazs + +And this is the content of the [Foobaz](@Foobazs) section. + + +Here's a ref. @{foobaz} What's it do? + +@{scratch-thing} + +--- scratch-things +(format "duplicate") +--- + +--- foobaz +(format nil (* 2 2)) +--- + +# Section 2 + +Here's a link to the scratch.lit code block. + +@{scratch-thing} + +And here's a link to a scratch.lit section. + +@{## Scratch} + +And here's a link to a scratch.lit chapter. + +@{# My scratch lit file} diff --git a/dev/scratch.lit b/dev/scratch.lit new file mode 100644 index 0000000..89a6260 --- /dev/null +++ b/dev/scratch.lit @@ -0,0 +1,12 @@ +# My scratch lit file + +## Scratch + +--- scratch.c +(format nil (* 2 2)) +@{scratch-thing} +--- + +--- scratch-thing +(+ 9 9) +--- diff --git a/parse.lisp b/parse.lisp index bf40932..eb8701f 100644 --- a/parse.lisp +++ b/parse.lisp @@ -34,10 +34,71 @@ :format-control "unknown modifier ~s" :format-arguments x)))) +;; The *anchor-pattern* and *ref-pattern* have negative lookbehinds to detect +;; and ignore `@@' so that you can weave `@@{some-reference}' into +;; `@{some-reference}'. +;; +;; So, `parse-anchor' and `parse-ref' will perform no action on those since they +;; won't match. +;; +;;`parse-escapes' must run *after* `parse-anchor' and `parse-ref'. If it runs +;; before, then it will translate `@@{some-ref}' to `@{some-ref}' which will +;; then get translated to `(:INCLUDE "some-ref")'. +(defparameter *escape-pattern* + (ppcre:create-scanner "@@({[^}]+})")) + +(defun parse-escapes (line) + (let ((parts (ppcre:split *escape-pattern* line :with-registers-p t))) + (mapcar-indexed + (lambda (string i) + (if (evenp i) + string + (format nil "@~a" string))) + parts))) + +(comment + (parse-escapes "Foobar @{# Baz} @@{# Buzz}") + ; => ("Foobar @{# Baz} " "@{# Buzz}") + ) + +(defparameter *anchor-pattern* + (ppcre:create-scanner '(:SEQUENCE + (:NEGATIVE-LOOKBEHIND #\@) + "@{" + (:REGISTER + (:SEQUENCE (:GREEDY-REPETITION 1 2 #\#) :WHITESPACE-CHAR-CLASS + (:NON-GREEDY-REPETITION 0 NIL :EVERYTHING))) + #\}) + ) + "This pattern matches @{# Some Chapter} and @{## Some Section}. +It doesn't match the escaped @@{# Some Chapter}.") + +(defun parse-anchor (line) + "Searches line for `*anchor-pattern*' and returns +(:ANCHOR (:C \"Some Chapter\")) for @{# Some Chapter} +and (:ANCHOR (:S \"Some Section\")) for @{## Some Section}." + (let ((parts (ppcre:split *anchor-pattern* line :with-registers-p t))) + (mapcar-indexed (lambda (string i) + (if (evenp i) + string + (list :ANCHOR (if (eql (char string 1) #\#) + (list :S (ppcre:regex-replace "##\\s+" string "")) + (list :C (ppcre:regex-replace "#\\s+" string "")))))) + parts))) + + +(comment + (let ((line "Foobar @{# Baz} @{## Biz} @@{# Boz} @{buz} @@{fizz}")) + (parse-anchor line)) + ; => ("Foobar " (:ANCHOR (:C "Baz")) " " (:ANCHOR (:S "Biz")) + ; " @@{# Boz} @{buz} @@{fizz}") + ) + (defparameter *ref-pattern* (ppcre:create-scanner '(:SEQUENCE (:NEGATIVE-LOOKBEHIND #\@) "@{" + (:NEGATIVE-LOOKAHEAD #\#) (:REGISTER (:GREEDY-REPETITION 1 NIL (:INVERTED-CHAR-CLASS #\}))) #\}))) @@ -45,7 +106,7 @@ (let ((parts (ppcre:split *ref-pattern* line :with-registers-p t))) (mapcar-indexed (lambda (string i) (if (evenp i) - (ppcre:regex-replace-all "@@({[^}]+})" string "@\\1") + string (list :INCLUDE string))) parts))) @@ -69,7 +130,6 @@ (:REGISTER (:GREEDY-REPETITION 1 nil #\#)) (:GREEDY-REPETITION 1 nil :WHITESPACE-CHAR-CLASS)))) - (defparameter *math-inline-pattern* (ppcre:create-scanner '(:SEQUENCE #\\ @@ -115,27 +175,93 @@ (push (subseq line start) expr) (nreverse expr))) +(defun parse-repeatedly (parsers line) + "Parses line with each parser. +Line starts off as a string. After the first parse, it will be a list of regular text and parsed segments. + +Example: + \"Some @{# some chapter} text @{some ref}\" + will turn into + (\"Some \" (:ANCHOR \"#some chapter\") \"text \" (:INCLUDE \"some ref\")). + +The subsequent parsers will be mapped over the result of the first parse. + +NOTE: +There's at least one issue with this. +`parse-escapes' handles the double `@@' as an escape sequence. +It truns `@@{# foo}' into `@{# foo}'. +So if we first `parse-escapes' and turn `@@{# foo}' into `@{# foo}' and then run `parse-anchors' after that +then we're bypassing our escape mechanism. +So, `parse-escapes' must be after `parse-refs' and `parse-anchors' in the list of parsers." + (cond + ((null line) nil) + ((null parsers) line) + ((stringp line) + (parse-repeatedly + (cdr parsers) + (funcall (car parsers) line))) + ((symbolp (car line)) (list line)) + (t (alexandria-2:mappend + (lambda (l) + (parse-repeatedly parsers l)) + line)))) + +(comment + (parse-repeatedly (list #'parse-anchor #'parse-refs #'parse-math-text #'parse-escapes) + "Foobar @{# Baz} @@{# Buzz} \\begin{math}n + m\\end{math} buz @{fizz}") + ; => ("Foobar " (:ANCHOR (:C "Baz")) " @{# Buzz} " (:MATH "n + m") " buz " + ; (:INCLUDE "fizz")) + (parse-repeatedly (list #'parse-anchor #'parse-escapes) + "(defvar foo @@{baz}") + ) + (defun parse-prose-line (line) (or - (multiple-value-bind (match groups) - (ppcre:scan-to-strings *heading-pattern* line) - (if match - (list (case (length (aref groups 0)) - (1 (list :C (subseq line (length match)))) - (2 (list :S (subseq line (length match)))) - (otherwise line))) - nil)) - (multiple-value-bind (match groups) - (ppcre:scan-to-strings *command-pattern* line) - (if match - (list (list (intern (string-upcase (aref groups 0)) :KEYWORD) - (subseq line (length match)))) - nil)) + (multiple-value-bind (match groups) + (ppcre:scan-to-strings *heading-pattern* line) + (if match + (list (case (length (aref groups 0)) + (1 (list :C (subseq line (length match)))) + (2 (list :S (subseq line (length match)))) + (otherwise line))) + nil)) + (multiple-value-bind (match groups) + (ppcre:scan-to-strings *command-pattern* line) + (if match + (list (list (intern (string-upcase (aref groups 0)) :KEYWORD) + (subseq line (length match)))) + nil)) + ;; Leaving this commented out while in PR review so that it's easy to try + ;; back and forth. + (comment (alexandria-2:mappend (lambda (expr) (if (stringp expr) (parse-math-text expr) (list expr))) - (parse-refs line)))) + (parse-refs line))) + (parse-repeatedly + (list #'parse-refs #'parse-math-text #'parse-anchor #'parse-escapes) + line))) + +(comment + ;; Some examples to getting a feel for behavior. + (parse-prose-line "\\n") + ; => ("\\n") + (parse-prose-line "") + ; => NIL + (parse-prose-line "Foobar @{# Baz} \\begin{math}n + m\\end{math} buz @{fizz}") + ; => ("Foobar " (:ANCHOR (:C "Baz")) " " (:MATH "n + m") " buz " (:INCLUDE "fizz")) + (parse-prose-line "Foobar @{fizz} \\begin{math}n + m\\end{math} buz @{# Baz}") + ; => ("Foobar " (:INCLUDE "fizz") " " (:MATH "n + m") " buz " (:ANCHOR (:C "Baz"))) + (parse-prose-line "# Some heading @{with a ref}") + ; => ((:C "Some heading @{with a ref}")) + (mapcar #'parse-prose-line + '("# Foobar" + "@{bazz}" + "" + "@{# Foobar}")) + ; => (((:C "Foobar")) ((:INCLUDE "bazz")) NIL ("" (:ANCHOR (:C "Foobar")))) + ) (defparameter *block-start-pattern* (ppcre:create-scanner '(:SEQUENCE :START-ANCHOR "---"))) @@ -160,37 +286,74 @@ (defun read-code-block (line n stream) (prog ((def nil)) - (multiple-value-bind (title operator modifiers) - (parse-block-start line) - - (when (null title) - (error 'user-error - :format-control "block is missing title on line: ~s" - :format-arguments (list n))) - - (setf def (make-textblockdef :line-number n - :kind :CODE - :title title - :operation (if (null operator) :DEFINE (first operator)) - :modifiers (if (is-filename title) - (cons :FILE modifiers) - modifiers) ))) - - TEXT - (setf line (strip-line (read-line stream nil))) - (incf n) - (when (null line) - (error 'user-error - :format-control "unexpected end of file in code block: ~s" - :format-arguments (list (textblockdef-title def)))) - - (when (ppcre:scan *block-start-pattern* line) - (return (values def line n))) - - (vector-push-extend (parse-refs line) - (textblock-lines (textblockdef-block def))) - (go TEXT))) - + (multiple-value-bind (title operator modifiers) + (parse-block-start line) + + (when (null title) + (error 'user-error + :format-control "block is missing title on line: ~s" + :format-arguments (list n))) + + (setf def (make-textblockdef :line-number n + :kind :CODE + :title title + :operation (if (null operator) :DEFINE (first operator)) + :modifiers (if (is-filename title) + (cons :FILE modifiers) + modifiers) ))) + + TEXT + (setf line (strip-line (read-line stream nil))) + (incf n) + (when (null line) + (error 'user-error + :format-control "unexpected end of file in code block: ~s" + :format-arguments (list (textblockdef-title def)))) + + (when (ppcre:scan *block-start-pattern* line) + (return (values def line n))) + + (vector-push-extend (parse-repeatedly (list #'parse-refs #'parse-escapes) line) + (textblock-lines (textblockdef-block def))) + (go TEXT))) + +(comment + (let ((s (make-string-output-stream))) + (format s "(defvar includes-regex @@{escaped include}~%") + (format s "---~%") + (format s "~%") + (read-code-block "--- foo" 0 (make-string-input-stream (get-output-stream-string s)))) + +; => #S(TEXTBLOCKDEF +; :TITLE "foo" +; :BLOCK #S(TEXTBLOCK +; :LINES #(("(defvar includes-regex " "@{escaped include}")) +; :MODIFY-DATE 0) +; :KIND :CODE +; :LINE-NUMBER 0 +; :FILE NIL +; :INDEX 0 +; :OPERATION :DEFINE +; :MODIFIERS NIL +; :LANGUAGE "text") +; "---" +; 2 + + ;; Just want to get a feel for what the def-table looks like + (let* ((file-defs (parse-lit-files '("dev/dev.lit" "dev/scratch.lit"))) + (weaver (make-weaver-default file-defs))) + (let ((defs (weaver-def-table weaver))) + (progn + (maphash (lambda (k v) + (format t "~a ~a~%" k v) + ) + defs) + (maphash + (lambda (k v) + (format t "~a: ~a~%" k v)) + (create-global-toc-linkmap (create-global-toc file-defs)))))) + + ) (defparameter *math-block-pattern* (ppcre:create-scanner diff --git a/toc.lisp b/toc.lisp index 5791018..a45f0d2 100644 --- a/toc.lisp +++ b/toc.lisp @@ -49,6 +49,45 @@ (textblockdef-create-toc (cdr pair))))) file-def-pairs)) +(defun create-global-toc-linkmap (toc) + "Creates a map of chapter/section names to the href when woven into a book file.html#s0:1. +The current implementation has the downside that subsequent chapter/section names +will overwrite antecedent chapter/section entries in the map. Users will just have +to be aware of this and make their chapter/section names unique." + (do ((linkmap (make-hash-table :test 'equal)) + (file (car toc) (car (cdr toc))) + (toc toc (cdr toc))) + ((null file) linkmap) + (do ((chapters (cddr file) (cdr chapters)) + (chapter (caddr file) (car (cdr chapters))) + (chapter-counter 0 (incf chapter-counter))) + ((null chapter)) + (let ((link (format nil "~a#c~a" (lit-page-filename (cadr file)) chapter-counter))) + (setf (gethash (cadr (subseq chapter 0 2)) linkmap) link) + (do ((sections (cddr chapter) (cdr sections)) + (section (caddr chapter) (car (cdr sections))) + (section-counter 0 (incf section-counter))) + ((null section)) + (let ((link (format nil "~a#s~a:~a" + (lit-page-filename (cadr file)) + chapter-counter + section-counter))) + (setf (gethash (cadr section) linkmap) link))))))) + +(comment + (let* ((file-defs (parse-lit-files '("dev/dev.lit" "dev/scratch.lit"))) + (linkmap (create-global-toc-linkmap (create-global-toc file-defs))) + (res nil)) + (maphash + (lambda (k v) + (setf res (cons (list k v) res))) + linkmap) + res) + + ; => (("Scratch" "scratch.html#s0:0") ("My scratch lit file" "scratch.html#c0") + ; ("Section 2" "dev.html#c1") ("Foobazs" "dev.html#s0:1") + ; ("Foobar" "dev.html#s0:0") ("My test lit file" "dev.html#c0")) + ) (defun weave-toc-section (name file chapter-counter section-counter) (format t "
  • ~a
    • " diff --git a/utils.lisp b/utils.lisp index 708192f..4ffe572 100644 --- a/utils.lisp +++ b/utils.lisp @@ -82,3 +82,7 @@ (define-condition user-error (simple-error) ()) +(defmacro comment (&rest body) + (declare (ignore body)) + nil) + diff --git a/weave.lisp b/weave.lisp index 4ac6d49..cd176ba 100644 --- a/weave.lisp +++ b/weave.lisp @@ -35,6 +35,12 @@ (used-extensions nil :type list) (used-math nil :type boolean)) +(comment + (let* ((file-defs (parse-lit-files '("dev/dev.lit" "dev/scratch.lit"))) + (weaver (make-weaver-default file-defs))) + weaver) + ) + (defun lit-page-filename (filename) (concatenate 'string (uiop:split-name-type filename) @@ -206,71 +212,80 @@ (write-line "")) (defun weave-prose-line (weaver line def) - (loop for expr in line do - (cond ((stringp expr) (write-string expr)) - ((commandp expr) - (case (first expr) - (:INCLUDE (weave-include - (second expr) - (textblockdef-file def) - weaver - nil)) - (:TITLE + (let ((linkmap (create-global-toc-linkmap (weaver-toc weaver)))) + (loop for expr in line do + (cond ((stringp expr) (write-string expr)) + ((commandp expr) + (case (first expr) + (:INCLUDE (weave-include + (second expr) + (textblockdef-file def) + weaver + nil)) + (:TITLE + (setf (weaver-title weaver) + (second expr))) + (:C + ; Also can act as a title + (when (null (weaver-title weaver)) (setf (weaver-title weaver) (second expr))) - (:C - ; Also can act as a title - (when (null (weaver-title weaver)) - (setf (weaver-title weaver) - (second expr))) - (incf (weaver-chapter-counter weaver)) - (setf (weaver-section-counter weaver) -1) - (format t "

    ~a

    ~%" - (second expr) - (chapter-id (weaver-chapter-counter weaver)))) - (:S - (incf (weaver-section-counter weaver)) - (format t "

    ~a. ~a

    ~%" - (+ (weaver-section-counter weaver) 1) - (second expr) - (section-id - (weaver-section-counter weaver) - (weaver-chapter-counter weaver)))) - (:CODE_TYPE - (let* ((args (split-whitespace (second expr))) - (language (first args)) - (extension (subseq (second args) 1))) - (setf (gethash extension (weaver-code-type-table weaver)) language) - (push extension (weaver-used-extensions weaver)))) - (:MATHBLOCK - ; Put tags in block so it displays tex nicely without JS. - (setf (weaver-used-math weaver) t) - (write-string "
    ") - (when (not (equal (second expr) "displaymath")) - (format t "\\begin{~a}" (second expr))) - (write-separated-list (third expr) #\newline *standard-output*) - (when (not (equal (second expr) "displaymath")) - (format t "\\end{~a}" (second expr))) - (write-string "
    ")) - (:MATH - ; Use backticks to prevent markdown from formatting tex, - ; for example treating _ as emphasis. - (setf (weaver-used-math weaver) t) - (format t "`~a`" - (second expr))) - (:TOC (weave-toc - (weaver-toc weaver) - (textblockdef-file def))) - - ; These commands are from Zach's Literate. - ; We treat them as warnings instead of errors to make migration easier. - ; It's possible they may be useful for us in the future. - ((:COMMENT_TYPE :ADD_CSS :OVERWRITE_CSS :COLORSCHEME :ERROR_FORMAT) - (warn "deprecated Literate prose command ~s. ignored." (first expr))) - (otherwise (error 'user-error - :format-control "unknown prose command ~S" - :format-arguments (first expr))))) - (t (error "unknown structure ~s" expr))))) + (incf (weaver-chapter-counter weaver)) + (setf (weaver-section-counter weaver) -1) + (format t "

    ~a

    ~%" + (second expr) + (chapter-id (weaver-chapter-counter weaver)))) + (:S + (incf (weaver-section-counter weaver)) + (format t "

    ~a. ~a

    ~%" + (+ (weaver-section-counter weaver) 1) + (second expr) + (section-id + (weaver-section-counter weaver) + (weaver-chapter-counter weaver)))) + (:CODE_TYPE + (let* ((args (split-whitespace (second expr))) + (language (first args)) + (extension (subseq (second args) 1))) + (setf (gethash extension (weaver-code-type-table weaver)) language) + (push extension (weaver-used-extensions weaver)))) + (:MATHBLOCK + ; Put tags in block so it displays tex nicely without JS. + (setf (weaver-used-math weaver) t) + (write-string "
    ") + (when (not (equal (second expr) "displaymath")) + (format t "\\begin{~a}" (second expr))) + (write-separated-list (third expr) #\newline *standard-output*) + (when (not (equal (second expr) "displaymath")) + (format t "\\end{~a}" (second expr))) + (write-string "
    ")) + (:MATH + ; Use backticks to prevent markdown from formatting tex, + ; for example treating _ as emphasis. + (setf (weaver-used-math weaver) t) + (format t "`~a`" + (second expr))) + (:TOC (weave-toc + (weaver-toc weaver) + (textblockdef-file def))) + (:ANCHOR + (let ((ref (cadadr expr))) + (write-string + (format + nil + "~a" + (gethash ref linkmap) + ref)))) + + ; These commands are from Zach's Literate. + ; We treat them as warnings instead of errors to make migration easier. + ; It's possible they may be useful for us in the future. + ((:COMMENT_TYPE :ADD_CSS :OVERWRITE_CSS :COLORSCHEME :ERROR_FORMAT) + (warn "deprecated Literate prose command ~s. ignored." (first expr))) + (otherwise (error 'user-error + :format-control "unknown prose command ~S" + :format-arguments (first expr))))) + (t (error "unknown structure ~s" expr)))))) (defun weave-prosedef (weaver def) (let ((block (textblockdef-block def)) @@ -280,6 +295,13 @@ (weave-prose-line weaver line def) (write-line "")))) +(comment + (let* ((file-defs (parse-lit-files '("dev/dev.lit" "dev/scratch.lit"))) + (weaver (make-weaver-default file-defs)) + (prosedef (nth 6 (cdar file-defs)))) + (weave-prosedef weaver prosedef)) + ) + (defun weave-blocks (weaver source-defs) (dolist (def source-defs) (when (textblockdef-weavable def)