diff --git a/main.rkt b/main.rkt index e78fac5..7027e0d 100644 --- a/main.rkt +++ b/main.rkt @@ -22,6 +22,7 @@ git-clone git-rev-list git-diff + git-show git-help git-version git-new-version @@ -307,6 +308,88 @@ (std-process-git-result cmd exit-code result output out info))) (std-process-git-result cmd exit-code result output out info)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Show a Git object, render a commit diff as HTML or return structured output. +; pre : The supplied arguments are valid for git show; --list/-l and +; --output=html/--output=-/--output=string are git-cli options. +; post : Git show has completed successfully or an exception has been raised. +; result : Structured Racket data with --list/-l, a string with --output=string, +; otherwise #t. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(def-cmd git-show cmd-git-show 'show + (λ (args info) + (let* ((list-output (ormap (λ (e) (member (format "~a" e) '("--list" "-l"))) args)) + (output-html (has-git-arg? args #px"^[-][-]output[=]html$")) + (output-stdout (has-git-arg? args #px"^[-][-]output[=][-]$")) + (output-string (has-git-arg? args #px"^[-][-]output[=]string$")) + (name-only (has-git-arg? args #px"^[-][-]name-only$")) + (name-status (has-git-arg? args #px"^[-][-]name-status$")) + (stat (has-git-arg? args #px"^[-][-]stat([=](.*))?$")) + (no-patch (or (has-git-arg? args #px"^[-][-]no-patch$") + (has-git-arg? args "-s"))) + (list-formats (filter (λ (x) x) + (list (if name-only 'name-only #f) + (if name-status 'name-status #f) + (if stat 'stat #f))))) + + (when (and list-output (or output-html output-stdout output-string)) + (error 'git-show "--list/-l cannot be combined with --output=...")) + (when (and list-output (> (length list-formats) 1)) + (error 'git-show "--list/-l accepts only one of --stat, --name-only or --name-status")) + + (hash-set! info 'scheme-format list-output) + (hash-set! info 'show-list-format (if (null? list-formats) 'stat (car list-formats))) + (hash-set! info 'show-output + (cond (output-html 'html) + (output-stdout 'stdout) + (output-string 'string) + ((or stat name-only name-status no-patch) 'stdout) + (else 'html))) + + (let ((nargs (filter (λ (e) + (not (member (format "~a" e) + '("--list" "-l" + "--output=html" "--output=-" "--output=string")))) + args))) + (if (and list-output (null? list-formats)) + (cons '--stat nargs) + nargs)))) + + (λ (cmd exit-code result output out info) + (if (and (zero? exit-code) result) + (cond + ((hash-ref info 'scheme-format #f) + (let ((lines (filter (λ (line) (not (string=? (string-trim line) ""))) out))) + (case (hash-ref info 'show-list-format 'stat) + ((name-only) lines) + ((name-status) (map (λ (line) (string-split line "\t")) lines)) + ((stat) + (let ((file-re #px"^\\s*(.*?)\\s+[|]\\s+([0-9]+)\\s+([+\\-]+)$") + (total-re #px"^([0-9]+) files? changed(, ([0-9]+) insertions?\\(\\+\\))?(, ([0-9]+) deletions?\\(-\\))?$")) + (map (λ (line) + (let* ((trimmed (string-trim line)) + (fm (regexp-match file-re line)) + (tm (regexp-match total-re trimmed))) + (cond + (fm (list 'file (cadr fm) (string->number (caddr fm)) (cadddr fm))) + (tm (list 'total + (string->number (cadr tm)) + (if (cadddr tm) (string->number (cadddr tm)) 0) + (if (list-ref tm 5) (string->number (list-ref tm 5)) 0))) + (else (list 'info line))))) + lines)))))) + ((eq? (hash-ref info 'show-output 'html) 'string) + (string-join out "\n")) + ((eq? (hash-ref info 'show-output 'html) 'html) + (show->html + (string-join + (filter (λ (line) (not (string-prefix? (string-downcase line) "warning:"))) out) + "\n")) + #t) + (else (std-process-git-result cmd exit-code result output out info))) + (std-process-git-result cmd exit-code result output out info)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Search tracked files for a pattern. ; pre : The supplied arguments are valid for git grep. diff --git a/private/diff.rkt b/private/diff.rkt index 75fed8e..5674aa7 100644 --- a/private/diff.rkt +++ b/private/diff.rkt @@ -1,16 +1,62 @@ #lang racket/base (require net/sendurl + racket/list json xml racket/string + "config.rkt" ) -(provide diff->html) +(provide diff->html + show->html) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Helper functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (make-js . args) (string-join args "\n")) +(define (highlight-css) + (cfg-get 'diff 'highlight-css + "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css") + ) + +(define (diff2html-min-css) + (cfg-get 'diff 'diff2html-min-css + "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css") + ) + +(define (diff2html-ui-min-js) + (cfg-get 'diff 'diff2html-ui-min-js + "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js") + ) + +(define (diff-script diff) + (format + (make-js + "window.do_diff = function() {" + "const diff = ~a;" + "const ui = new Diff2HtmlUI(" + " document.getElementById('diff')," + " diff," + " {" + " drawFileList: true," + " matching: 'lines'," + " outputFormat: 'side-by-side'," + " });" + "ui.draw();" + "ui.highlightCode();" + "};" + ) + (jsexpr->string diff)) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Exported functions +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; goal : Render a Git diff in a temporary HTML file. ; pre : diff is a unified Git diff string. @@ -18,44 +64,77 @@ ; result : void. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define (diff->html diff) - (let ((highlight-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css") - (diff2html-min-css "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css") - (diff2html-ui-min-js "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js")) - (let ((html `(html - (head - (meta ((charset "utf-8"))) - (link ((rel "stylesheet") (href ,highlight-css))) - (link ((rel "stylesheet") (href ,diff2html-min-css))) - (script ((src ,diff2html-ui-min-js)) "") - (script ,(format - (make-js - "window.do_diff = function() {" - "const diff = ~a;" - "const ui = new Diff2HtmlUI(" - " document.getElementById('diff')," - " diff," - " {" - " drawFileList: true," - " matching: 'lines'," - " outputFormat: 'side-by-side'," - " });" - "ui.draw();" - "ui.highlightCode();" - "};" - ) - (jsexpr->string diff)) - ) - ) - (body - (div ((id "diff"))) - (script ((type "text/javascript")) - "window.do_diff();") - )))) - (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-diff.html"))) - (call-with-output-file tmp-file #:exists 'truncate - (λ (out) - (display (xexpr->string html) out))) - (send-url/file tmp-file))))) - - + (let ((html `(html + (head + (meta ((charset "utf-8"))) + (link ((rel "stylesheet") (href ,(highlight-css) ))) + (link ((rel "stylesheet") (href ,(diff2html-min-css) ))) + (script ((src ,diff2html-ui-min-js)) "") + (script ,(diff-script diff)) + ) + (body + (div ((id "diff"))) + (script ((type "text/javascript")) + "window.do_diff();") + )))) + (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-diff.html"))) + (call-with-output-file tmp-file #:exists 'truncate + (λ (out) + (display (xexpr->string html) out))) + (send-url/file tmp-file)))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +; goal : Render git show output as commit information followed by a diff. +; pre : show is the textual output produced by git show. +; post : The generated HTML file has been opened in the default browser. +; result : void. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +(define (show->html show) + (let* ((lines (string-split show "\n" #:trim? #f)) + (diff-pos (let loop ((rest lines) (n 0)) + (cond ((null? rest) #f) + ((string-prefix? (car rest) "diff --git ") n) + (else (loop (cdr rest) (+ n 1)))))) + (header (string-join (if diff-pos (take lines diff-pos) lines) "\n")) + (diff (string-join (if diff-pos (drop lines diff-pos) '()) "\n")) + (highlight-css "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css") + (diff2html-min-css "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css") + (diff2html-ui-min-js "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js") + (html + `(html + (head + (meta ((charset "utf-8"))) + (link ((rel "stylesheet") (href ,highlight-css))) + (link ((rel "stylesheet") (href ,diff2html-min-css))) + (style "body { font-family: sans-serif; margin: 1.5em; } pre.commit { white-space: pre-wrap; }") + ,@(if diff-pos + `((script ((src ,diff2html-ui-min-js)) "") + (script + ,(format + (make-js + "window.do_diff = function() {" + "const diff = ~a;" + "const ui = new Diff2HtmlUI(" + " document.getElementById('diff')," + " diff," + " {" + " drawFileList: true," + " matching: 'lines'," + " outputFormat: 'side-by-side'," + " });" + "ui.draw();" + "ui.highlightCode();" + "};") + (jsexpr->string diff)))) + '())) + (body + (pre ((class "commit")) ,header) + ,@(if diff-pos + `((div ((id "diff"))) + (script ((type "text/javascript")) "window.do_diff();")) + '())))) + (tmp-file (build-path (find-system-path 'temp-dir) "racket-git-show.html"))) + (call-with-output-file tmp-file #:exists 'truncate + (λ (out) (display (xexpr->string html) out))) + (send-url/file tmp-file))) diff --git a/scribblings/git.scrbl b/scribblings/git.scrbl index dcdd8e9..dc7035a 100644 --- a/scribblings/git.scrbl +++ b/scribblings/git.scrbl @@ -20,7 +20,7 @@ Runs a registered Git @racket[command]. The arguments are passed to the command. Registered command symbols are @racket['status], @racket['add], @racket['commit], @racket['push], @racket['pull], @racket['branch], @racket['clone], @racket['log], @racket['rev-list], @racket['diff], -@racket['grep], @racket['help], @racket['version], and +@racket['show], @racket['grep], @racket['help], @racket['version], and @racket['new-version]. Most registered commands invoke the Git command with the same name. Some @@ -94,6 +94,48 @@ extra output lines can also influence how useful @tt{--list} is as a structured result. } + + +@defproc[(git-show [argument any/c] ...) (or/c boolean? string? list?)]{ +Shows a Git object. + +For a commit that includes a patch, the default git-cli output is HTML. The +commit information is shown above the diff and the diff is rendered using the +same Diff2Html presentation as @racket[git-diff]. + +The git-cli-specific output options are @tt{--output=html}, +@tt{--output=-}, and @tt{--output=string}. @tt{--output=html} explicitly +selects the HTML presentation, @tt{--output=-} keeps Git's normal textual +output, and @tt{--output=string} returns that textual output as a string. +Options such as @tt{--stat}, @tt{--name-only}, @tt{--name-status}, and +@tt{--no-patch} default to textual output because they do not normally contain +a patch. + +The git-cli-specific option @tt{--list}, or its short form @tt{-l}, returns a +Racket value. Without another show-format option it implies @tt{--stat}. + +@racketblock[ +(git-show '-l "9741b1c") +] + +The result of @tt{--stat --list} contains @racket['file] and +@racket['total] items: + +@racketblock[ +'((file "README.md" 67 "+++---") + (file "main.rkt" 532 "++++-------------------------------------------") + (total 9 124 823)) +] + +With @tt{--name-only --list}, the result is a list of file names. With +@tt{--name-status --list}, every result item is the tab-separated Git +name-status record converted to a list of strings. + +@tt{--list}/@tt{-l} cannot be combined with @tt{--output=...}. Only one of +@tt{--stat}, @tt{--name-only}, and @tt{--name-status} can be used with +@tt{--list}. +} + @defproc[(git-grep [argument any/c] ...) list?]{ Searches tracked files. Each result contains the file, optional line number, optional match count, and matched text. Exit status one means that no matches