Improve diff display

Julien LepillerSun Mar 07 02:50:47+0100 2021

3245b94

Improve diff display

gitile/pages.scm

195195 
196196 
(define (project-commit repository-name repo ref)
197197 
  (let* ((commit (get-commit repo ref))
198-
         (parent (commit-parent commit)))
198+
         (parent (commit-parent commit))
199+
         (diff (diff-tree-to-tree repo (commit-tree parent) (commit-tree commit))))
199200 
    `(,(commit-infobox repository-name commit #:open? #t)
200201 
      (p (@ (class "commit-summary")) ,(commit-summary commit))
201-
      (pre (@ (class "diff"))
202-
        ,(diff->string (diff-tree-to-tree repo (commit-tree parent)
203-
                                          (commit-tree commit)))))))
202+
      ,(diff-box diff))))
203+
204+
(define (diff-box diff)
205+
  (let ((content '()) (file-header #f) (file-content #f) (first-hunk #t))
206+
    (diff-foreach diff
207+
      (lambda (delta progress)
208+
        (pk 'file delta progress)
209+
        (when file-header
210+
          (set! content (append content (cons file-header `((table (@ (class "file-diff")) ,(reverse file-content)))))))
211+
        (set! first-hunk #t)
212+
        (set! file-content '())
213+
        (cond
214+
          ((equal? (diff-delta-status delta) GIT-DELTA-MODIFIED)
215+
           (set! file-header
216+
             `(p (@ (class "file-name")) ,(diff-file-path (diff-delta-old-file delta)))))
217+
          (else
218+
            (set! file-header
219+
              `(p (@ (class "file-name"))
220+
                  ,(diff-file-path (diff-delta-old-file delta))
221+
                  " unknown status "
222+
                  ,(number->string (diff-delta-status delta))))))
223+
        0)
224+
      (lambda (delta binary)
225+
        (set! file-content `((tr (@ (class "hunk-delim")) (td (@ (colspan 4)) "Binary data"))))
226+
        0)
227+
      (lambda (delta hunk)
228+
        (if first-hunk
229+
            (set! first-hunk #f)
230+
            (set! file-content
231+
              (append file-content `((tr (@ (class "hunk-delim")) (td (@ (colspan 4)) "???"))))))
232+
        0)
233+
      (lambda (delta hunk line)
234+
        (let* ((origin (list->string (list (integer->char (diff-line-origin line)))))
235+
               (class (match origin
236+
                        ("-" "diff-minus")
237+
                        ("+" "diff-plus")
238+
                        (_ ""))))
239+
          (let loop ((lines (string-split (diff-line-content line) #\newline))
240+
                     (old-line (diff-line-old-lineno line))
241+
                     (new-line (diff-line-new-lineno line)))
242+
            (match lines
243+
              (() #t)
244+
              (("") #t)
245+
              ((line lines ...)
246+
               (set! file-content
247+
                 (append file-content `((tr
248+
                                          (td ,old-line)
249+
                                          (td ,new-line)
250+
                                          (td ,origin)
251+
                                          (td (@ (class ,(string-append class " diff-line")))
252+
                                              (pre ,line "\n"))))))
253+
               (loop lines (+ old-line 1) (+ new-line 1))))))
254+
        0))
255+
    (append content (cons file-header file-content))))
gitile/repo.scm
142142 
(define (get-description repo)
143143 
  (let* ((config (repository-config repo))
144144 
         (options (get-options config)))
145-
    (assoc-ref options "gitweb.description")))
145+
    (or (assoc-ref options "gitweb.description") "")))
146146 
147147 
(define (get-commit repo hash)
148148 
  (let* ((oid (ref->oid repo hash))
guix.scm
3434 
              (method git-fetch)
3535 
              (uri (git-reference
3636 
                     (url "https://gitlab.com/roptat/guile-git")
37-
                     (commit "8b752feec04138429a973080cc0170a376b73cda")))
38-
              (file-name (git-file-name "guile-git" "0.4.0.8b752fe"))
37+
                     (commit "c39ab944d8004d3ab751a9e27336469afec081eb")))
38+
              (file-name (git-file-name "guile-git" "0.4.0.c39ab94"))
3939 
              (sha256
4040 
               (base32
41-
                "11k3h1spy2dlvc2lq9hpr0yypm9pav3y7d46dmwca31dlchj4jz8"))))
41+
                "0hknsv9r7pjahmxkvd7zpz93saki5kymh88xs6pb4h9d0ssp4fmp"))))
4242 
    (native-inputs
4343 
     `(("autoconf" ,autoconf)
4444 
       ("automake" ,automake)