Add ability to link to chapter/section

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

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}

dev/scratch.lit

@@ -0,0 +1,12 @@
+# My scratch lit file
+
+## Scratch
+
+--- scratch.c
+(format nil (* 2 2))
+@{scratch-thing}
+---
+
+--- scratch-thing
+(+ 9 9)
+---

parse.lisp

@@ -34,18 +34,79 @@
                   :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 #\})))
                           #\})))
 
 (defun parse-refs (line)
   (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