diff options
| -rw-r--r-- | assets/css/screen.css | 11 | ||||
| -rw-r--r-- | mumi/web/view/utils.scm | 81 |
2 files changed, 63 insertions, 29 deletions
diff --git a/assets/css/screen.css b/assets/css/screen.css index df8aec3..790a8b3 100644 --- a/assets/css/screen.css +++ b/assets/css/screen.css @@ -176,6 +176,17 @@ table { 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; diff --git a/mumi/web/view/utils.scm b/mumi/web/view/utils.scm index 4a4ecb0..ea5b8c6 100644 --- a/mumi/web/view/utils.scm +++ b/mumi/web/view/utils.scm @@ -53,7 +53,7 @@ (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." @@ -74,22 +74,28 @@ with the next context." ((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) - `(div (@ (class "line diff separator")) ,line)) + `(div (@ (class "line diff separator")) + ,line-anchor ,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))) - `(div (@ (class "line diff deletion")) ,line)) + `(div (@ (class "line diff deletion")) + ,line-anchor ,line)) ((string-prefix? "@@" line) - `(div (@ (class "line diff range")) ,line)) + `(div (@ (class "line diff range")) + ,line-anchor ,line)) (else - `(div (@ (class "line")) ,line))))) + `(div (@ (class "line")) + ,line-anchor + ,line))))) (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 - `(div (@ (class "line")) ,line)) + `(div (@ (class "line")) + ,line-anchor + ,line)) other-blocks) context) ;; Retry - (process line blocks #f))) + (process line blocks #f line-anchor))) (else (let ((new-context (cond @@ -125,27 +133,33 @@ with the next context." (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 " ")))) - `(div (@ (class "line")) ,line))))))) + `(div (@ (class "line")) + ,line-anchor ,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)) - `(div (@ (class "line commit header")) ,line)) + `(div (@ (class "line commit header")) + ,line-anchor ,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) - `(div (@ (class "line diff file")) ,line)) + `(div (@ (class "line diff file")) + ,line-anchor ,line)) ((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) @@ -154,19 +168,28 @@ with the next 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)))) @@ -274,7 +297,7 @@ BUG-NUM), even when it is a multipart message." (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)) |