view: Add line anchors.
authorRicardo Wurmus <rekado@elephly.net>
Thu, 9 Dec 2021 17:17:31 +0000 (18:17 +0100)
committerRicardo Wurmus <rekado@elephly.net>
Thu, 9 Dec 2021 17:17:31 +0000 (18:17 +0100)
assets/css/screen.css
mumi/web/view/utils.scm

index df8aec39117ee831b7e273dd23a5b1e0dc960a78..790a8b312ff4a6803e0fdacdf5ceea78185ec4d7 100644 (file)
@@ -176,6 +176,17 @@ table {
     display: block;
 }
 
     display: block;
 }
 
+a.line-anchor {
+    margin-left: -2em;
+    padding-right: 2em;
+    position: absolute;
+    visibility: hidden;
+}
+
+div.line:hover a.line-anchor {
+    visibility: visible;
+}
+
 a.message-anchor {
     display: block;
     position: relative;
 a.message-anchor {
     display: block;
     position: relative;
index 4a4ecb0d4389b6a1c458d3a28a2997f3afe70fd2..ea5b8c68964a060e4f480d6ca913adaca4e0ccc7 100644 (file)
@@ -53,7 +53,7 @@
                     (cons line (block-raw-lines block)))
   block)
 
                     (cons line (block-raw-lines block)))
   block)
 
-(define (process line blocks context)
+(define (process line blocks context line-anchor)
   "Process the current LINE.  Add it to the latest block in BLOCKS or
 add it to a new block, dependent on CONTEXT.  Return the blocks along
 with the next context."
   "Process the current LINE.  Add it to the latest block in BLOCKS or
 add it to a new block, dependent on CONTEXT.  Return the blocks along
 with the next context."
@@ -74,22 +74,28 @@ with the next context."
       ((eq? context 'diff)
        (if (string= "--" line)
            ;; Retry
       ((eq? context 'diff)
        (if (string= "--" line)
            ;; Retry
-           (process line blocks #f)
+           (process line blocks #f line-anchor)
            ;; Format line and add to current block
            (let ((formatted-line
                   (cond
                    ((string= "---" line)
            ;; Format line and add to current block
            (let ((formatted-line
                   (cond
                    ((string= "---" line)
-                    `(div (@ (class "line diff separator")) ,line))
+                    `(div (@ (class "line diff separator"))
+                          ,line-anchor ,line))
                    ((string-prefix? "+" line)
                    ((string-prefix? "+" line)
-                    `(div (@ (class "line diff addition")) ,line))
+                    `(div (@ (class "line diff addition"))
+                          ,line-anchor ,line))
                    ((and (string-prefix? "-" line)
                          (not (string= "--" line))
                          (not (string= "-- " line)))
                    ((and (string-prefix? "-" line)
                          (not (string= "--" line))
                          (not (string= "-- " line)))
-                    `(div (@ (class "line diff deletion")) ,line))
+                    `(div (@ (class "line diff deletion"))
+                          ,line-anchor ,line))
                    ((string-prefix? "@@" line)
                    ((string-prefix? "@@" line)
-                    `(div (@ (class "line diff range")) ,line))
+                    `(div (@ (class "line diff range"))
+                          ,line-anchor ,line))
                    (else
                    (else
-                    `(div (@ (class "line")) ,line)))))
+                    `(div (@ (class "line"))
+                          ,line-anchor
+                          ,line)))))
              (values (cons (add-block-line! block formatted-line)
                            other-blocks)
                      context))))
              (values (cons (add-block-line! block formatted-line)
                            other-blocks)
                      context))))
@@ -97,11 +103,13 @@ with the next context."
        (if (string-prefix? ">" line)
            ;; Add line to current block
            (values (cons (add-block-line! block
        (if (string-prefix? ">" line)
            ;; Add line to current block
            (values (cons (add-block-line! block
-                                          `(div (@ (class "line")) ,line))
+                                          `(div (@ (class "line"))
+                                                ,line-anchor
+                                                ,line))
                          other-blocks)
                    context)
            ;; Retry
                          other-blocks)
                    context)
            ;; Retry
-           (process line blocks #f)))
+           (process line blocks #f line-anchor)))
       (else
        (let ((new-context
               (cond
       (else
        (let ((new-context
               (cond
@@ -125,27 +133,33 @@ with the next context."
                            (or (and=> (string->uri uri-string)
                                       (lambda (uri)
                                         `(div (@ (class "line"))
                            (or (and=> (string->uri uri-string)
                                       (lambda (uri)
                                         `(div (@ (class "line"))
+                                              ,line-anchor
                                               ,(string-trim-right pre #\<)
                                               (a (@ (href ,uri-string))
                                                  ,uri-string)
                                               ,(string-join rest " "))))
                                               ,(string-trim-right pre #\<)
                                               (a (@ (href ,uri-string))
                                                  ,uri-string)
                                               ,(string-join rest " "))))
-                               `(div (@ (class "line")) ,line)))))))
+                               `(div (@ (class "line"))
+                                      ,line-anchor ,line)))))))
                ((or (string-prefix? "Signed-off-by" line)
                     (string-prefix? "Co-authored-by" line))
                ((or (string-prefix? "Signed-off-by" line)
                     (string-prefix? "Co-authored-by" line))
-                `(div (@ (class "line commit attribution")) ,line))
+                `(div (@ (class "line commit attribution"))
+                      ,line-anchor ,line))
                ((or (string-prefix? "From: " line)
                     (string-prefix? "Date: " line)
                     (string-prefix? "Subject: " line))
                ((or (string-prefix? "From: " line)
                     (string-prefix? "Date: " line)
                     (string-prefix? "Subject: " line))
-                `(div (@ (class "line commit header")) ,line))
+                `(div (@ (class "line commit header"))
+                       ,line-anchor ,line))
                ((or (string-prefix? "* " line)
                     (string-prefix? " * " line))
                ((or (string-prefix? "* " line)
                     (string-prefix? " * " line))
-                `(div (@ (class "line commit changelog")) ,line))
+                `(div (@ (class "line commit changelog"))
+                      ,line-anchor ,line))
                ((string-prefix? "diff --git" line)
                ((string-prefix? "diff --git" line)
-                `(div (@ (class "line diff file")) ,line))
+                `(div (@ (class "line diff file"))
+                       ,line-anchor ,line))
                ((string-prefix? "--8<---------------cut here" line)
                 "")
                (else
                ((string-prefix? "--8<---------------cut here" line)
                 "")
                (else
-                `(div (@ (class "line")) ,line)))))
+                `(div (@ (class "line")) ,line-anchor ,line)))))
          (if (eq? new-context context)
              (values (cons (add-block-line! block formatted-line)
                            other-blocks)
          (if (eq? new-context context)
              (values (cons (add-block-line! block formatted-line)
                            other-blocks)
@@ -154,19 +168,28 @@ with the next context."
                            blocks)
                      new-context))))))))
 
                            blocks)
                      new-context))))))))
 
-(define (prettify text)
-  "Read each line of TEXT and apply PROCESS to it."
-  (let ((res (fold (lambda (line acc)
-                     (call-with-values
-                         (lambda ()
-                           (process line
-                                    (cadr (memq #:blocks acc))
-                                    (cadr (memq #:context acc))))
-                       (lambda (new-blocks new-context)
-                         `(#:blocks ,new-blocks #:context ,new-context))))
-                   (list #:blocks (list (make-block 'text '()))
-                         #:context 'text)
-                   (string-split text #\newline))))
+(define (prettify text message-number)
+  "Read each line of TEXT and apply PROCESS to it.  Prefix line
+numbers with the given MESSAGE-NUMBER."
+  (let* ((lines (string-split text #\newline))
+         (res (fold (lambda (line line-number acc)
+                      (call-with-values
+                          (lambda ()
+                            (process line
+                                     (cadr (memq #:blocks acc))
+                                     (cadr (memq #:context acc))
+                                     `(a (@ (class "line-anchor")
+                                            (id ,(format #false "~a-lineno~a"
+                                                         message-number line-number))
+                                            (href ,(format #false "#~a-lineno~a"
+                                                           message-number line-number)))
+                                         "#")))
+                        (lambda (new-blocks new-context)
+                          `(#:blocks ,new-blocks #:context ,new-context))))
+                    (list #:blocks (list (make-block 'text '()))
+                          #:context 'text)
+                    lines
+                    (iota (length lines)))))
     (map (lambda (block)
            (if (eq? 'text (block-type block))
                `(div (@ (class ,(format #f "block ~a" (block-type block))))
     (map (lambda (block)
            (if (eq? 'text (block-type block))
                `(div (@ (class ,(format #f "block ~a" (block-type block))))
@@ -274,7 +297,7 @@ BUG-NUM), even when it is a multipart message."
               (div (@ (class "download-part"))
                    (a (@ (href ,(attachment-url)))
                       ,download-icon))
               (div (@ (class "download-part"))
                    (a (@ (href ,(attachment-url)))
                       ,download-icon))
-              ,(prettify body))))))
+              ,(prettify body message-number))))))
   (define (display-mime-entity entity . path)
     (match entity
       (($ <mime-entity> headers (? string? body))
   (define (display-mime-entity entity . path)
     (match entity
       (($ <mime-entity> headers (? string? body))