Added git-grep and git-diff

private/diff.rkt

@@ -0,0 +1,55 @@
+#lang racket/base
+
+(require net/sendurl
+         json
+         xml
+         racket/string
+         )
+
+(provide diff->html)
+
+(define (make-js . args)
+  (string-join args "\n"))
+
+(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)))))
+      
+      
+

private/git-commands.rkt

@@ -12,19 +12,20 @@
 
 
 (define (has-git-arg? args opt)
-  (if (list? args)
-      (if (null? args)
-          #f
-          (if (symbol? opt)
-              (if (or (eq? (car args) opt)
-                      (and (string? (car args))
-                           (string=? (car args) (symbol->string opt))))
-                  #t
-                  (has-git-arg? (cdr args) opt))
-              (error 'has-git-arg? "opt must be of type symbol?")))
-      (error 'has-git-arg? "args must be a list of arguments")
-      )
-  )
+  (let ((cmp (cond ((symbol? opt) (λ (x) (eq? x opt)))
+                   ((string? opt) (λ (x) (string=? (format "~a" x) opt)))
+                   ((regexp? opt) (λ (x) (regexp-match opt (format "~a" x))))
+                   (else (error "opt must be a string, symbol or regular expression")))))
+    (letrec ((f (λ (args)
+                  (if (null? args)
+                      #f
+                      (let ((m (cmp (car args))))
+                        (if m
+                            m
+                            (f (cdr args))))))))
+      (if (list? args)
+          (f args)
+          (error 'has-git-arg? "args must be a list of arguments")))))
 
 (define (check-git-args cmd args flags)
   (for-each
@@ -49,26 +50,31 @@
   args)
 
 
-(define (std-process-git-result cmd exit-code result output out)
-  (git-displ out)
-  (if result
-      (if (= exit-code 0)
-          #t
-          #f)
-      (git-error cmd "Error" out)))
+(define (std-process-git-result cmd exit-code result output out info)
+  (if (= exit-code 0)
+      (if result
+          (begin
+            (git-displ out)
+            #t)
+          (git-error cmd "Error" out))
+      (git-error cmd (format "Exitcode <> 0: ~a" exit-code) out)
+      )
+  )
+            
 
 (define-syntax def-git-cmd-proxy
   (syntax-rules ()
     ((_ f cmd)
-     (def-proxy-cmd f cmd (λ args t) standard-result))
+     (def-proxy-cmd f cmd (λ (args info) args) standard-result))
     ((_ f cmd pre-code)
      (def-proxy-cmd f cmd pre-code standard-result))
     ((_ f cmd pre-code process-result)
      (define (f args)
-       (let ((nargs (pre-code args)))
+       (let* ((info (make-hash))
+              (nargs (pre-code args info)))
          (let-values (((exit-code output) (run-git (cons cmd nargs))))
            (let-values (((result out) (git-out cmd output)))
-             (process-result cmd exit-code result output out))))))
+             (process-result cmd exit-code result output out info))))))
     )
   )
 

private/git-provider.rkt

@@ -80,11 +80,8 @@
                        #f
                        #f
                        (git-exe)
-                       (map (lambda (arg)
-                              (if (symbol? arg)
-                                  (symbol->string arg)
-                                  arg))
-                            args))))
+                       (map (λ (arg) (format "~a" arg)) args)
+                       )))
     (close-output-port stdin)
     (let ((output-channel (make-channel)))
         (define (read-output source port)
@@ -154,9 +151,12 @@
     )
   )
 
+(define re-a #px"~+")
+
 (define (git-displ out)
   (let ((str (if (string? out) out (string-join out "\n"))))
     (unless (string=? (string-trim str) "")
-      (info-git str)
+      (let ((s (regexp-replace* re-a str "~~")))
+        (info-git s))
       (when (cfg-get 'git 'display-output #t)
         (displayln str)))))