prettify: Pass down a bit of context to avoid false matches.

1 files changed, 41 insertions, 31 deletions

diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm
index 9547f4b..8043c4e 100644
--- a/mumi/web/view/utils.scm
+++ b/mumi/web/view/utils.scm
@@ -19,7 +19,9 @@
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
+  #:use-module (ice-9 receive)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26)
   #:use-module (syntax-highlight)
   #:use-module (syntax-highlight scheme)
   #:use-module (debbugs email)
@@ -30,52 +32,60 @@
 
 ;; TODO: at some point this should tokenize the text, then apply
 ;; styles, then output sxml, but for now we keep it simple
-(define (process line)
+(define (process line context)
   (cond
    ((string-prefix? "--8<---------------cut here" line)
-    `(span (@ (class "line cut-here")) ,line))
-   ((string= "---" line)
-    `(span (@ (class "line diff separator")) ,line))
+    (values `(span (@ (class "line cut-here")) ,line) #f))
+   ((and (member 'diff context)
+         (string= "---" line))
+    (values `(span (@ (class "line diff separator")) ,line) #f))
    ((string-prefix? "diff --git" line)
-    `(span (@ (class "line diff file")) ,line))
-   ((string-prefix? "+" line)
-    `(span (@ (class "line diff addition")) ,line))
-   ((and (string-prefix? "-" line)
+    (values `(span (@ (class "line diff file")) ,line) 'diff))
+   ((and (member 'diff context)
+         (string-prefix? "+" line))
+    (values `(span (@ (class "line diff addition")) ,line) #f))
+   ((and (member 'diff context)
+         (string-prefix? "-" line)
          (not (string= "--" line))
          (not (string= "-- " line)))
-    `(span (@ (class "line diff deletion")) ,line))
-   ((string-prefix? "@@" line)
-    `(span (@ (class "line diff range")) ,line))
+    (values `(span (@ (class "line diff deletion")) ,line) #f))
+   ((and (member 'diff context)
+         (string-prefix? "@@" line))
+    (values `(span (@ (class "line diff range")) ,line) #f))
    ((string-prefix? ">" line)
-    `(span (@ (class "line quote")) ,line))
+    (values `(span (@ (class "line quote")) ,line) #f))
    ((or (string-prefix? "Signed-off-by" line)
         (string-prefix? "Co-authored-by" line))
-    `(span (@ (class "commit attribution")) ,line))
+    (values `(span (@ (class "commit attribution")) ,line) #f))
    ((or (string-prefix? "From: " line)
         (string-prefix? "Date: " line)
         (string-prefix? "Subject: " line))
-    `(span (@ (class "commit header")) ,line))
-   ((or (string-prefix? "* " line)
-        (string-prefix? " * " line))
-    `(span (@ (class "commit changelog")) ,line))
+    (values `(span (@ (class "commit header")) ,line) 'commit))
+   ((and (member 'commit context)
+         (or (string-prefix? "* " line)
+             (string-prefix? " * " line)))
+    (values `(span (@ (class "commit changelog")) ,line) #f))
    (else
-    `(span (@ (class "line")) ,line))))
+    (values `(span (@ (class "line")) ,line) #f))))
 
 (define (prettify text)
   "Read each line of TEXT and apply PROCESS to it."
-  (call-with-input-string text
-    (lambda (port)
-      (let loop ((line (read-line port))
-                 (result '()))
-        (if (eof-object? line)
-            ;; Drop the first line break, because it's for an eof
-            ;; read.
-            (match (reverse result)
-              ((_ . rest) rest)
-              (() '()))
-            (loop (read-line port)
-                  (cons (process line)
-                        (cons '(br) result))))))))
+  (let ((res (fold (lambda (line acc)
+                     (match acc
+                       ((#:result res #:context context)
+                        (receive (processed new-context)
+                            (process line context)
+                          `(#:result ,(append (list processed '(br)) res)
+                            #:context ,(if new-context
+                                           (cons new-context context)
+                                           context))))))
+                   '(#:result () #:context ())
+                   (string-split text #\newline))))
+    ;; Drop the first line break, because it's for an eof
+    ;; read.
+    (match (reverse (cadr (find-tail (cut eq? #:result <>) res)))
+      ((_ . rest) rest)
+      (() '()))))
 
 (define colors
   (circular-list "#8dd3c7" "#bebada" "#fb8072"