hans/git-cli
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Revert "Diverse commando's toegevoegd. Ik weet nog niet of ik ze allemaal ga houden"

Browse Source 
This reverts commit 003f3713f0.
This commit is contained in:
Hans Dijkema
2026-08-13 09:17:46 +02:00
parent 003f3713f0
commit 9741b1cf51
9 changed files with 130 additions and 829 deletions
Download Patch File Download Diff File Expand all files Collapse all files
private/config.rkt
+1 -12
View File
@@ -43,24 +43,13 @@
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Store one git-cli configuration value.
; pre : section and key identify a simple-ini setting.
; post : value has been persisted.
; result : The result returned by simple-ini.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cfg-set! section key value)
(critical
(check-ini)
(send ini set! section key value)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read one git-cli configuration value.
; pre : section and key identify a simple-ini setting.
; post : Configuration has not been changed.
; result : The stored value or default-value.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cfg-get section key default-value)
(critical
(check-ini)
(send ini get section key default-value)))
private/diff.rkt
+1 -6
View File
@@ -11,12 +11,6 @@
(define (make-js . args)
(string-join args "\n"))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Render a Git diff in a temporary HTML file.
; pre : diff is a unified Git diff string.
; post : The generated HTML file has been opened in the default browser.
; 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")
@@ -58,3 +52,4 @@
(send-url/file tmp-file)))))
private/git-commands.rkt
+9 -24
View File
@@ -11,12 +11,7 @@
std-process-git-result
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Determine whether a Git option occurs in an argument list.
; pre : args is a list and opt is a symbol, string or regular expression.
; post : args has only been inspected.
; result : The match result, or #f when the option is absent.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (has-git-arg? args opt)
(let ((cmp (cond ((symbol? opt) (λ (x) (eq? x opt)))
((string? opt) (λ (x) (string=? (format "~a" x) opt)))
@@ -33,12 +28,6 @@
(f args)
(error 'has-git-arg? "args must be a list of arguments")))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Check that mandatory Git options and their arguments are present.
; pre : flags contains (option argument-count error-message) items.
; post : Missing options have raised an exception.
; result : args when every mandatory option is present.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (check-git-args cmd args flags)
(for-each
(λ (opt)
@@ -62,12 +51,10 @@
args)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Process the standard result of a Git command.
; pre : exit-code and out belong to the completed Git command.
; post : Successful output has been displayed or a Git exception has been raised.
; result : #t when exit-code is zero.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; goal: Process the standard result of a Git command.
;; pre: exit-code and out belong to the completed Git command.
;; post: Successful output has been displayed or a Git exception has been raised.
;; result: #t when exit-code is zero.
(define (std-process-git-result cmd exit-code result output out info)
(if (= exit-code 0)
(begin
@@ -78,12 +65,10 @@
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Define the internal proxy for a Git command.
; pre : pre-code and process-result accept the command proxy arguments.
; post : The proxy invokes Git without standard input and processes its result.
; result : A procedure named f accepting a list of Git arguments.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; goal: Define the internal proxy for a Git command.
;; pre: pre-code and process-result accept the command proxy arguments.
;; post: The proxy invokes Git without standard input and processes its result.
;; result: A procedure named f accepting a list of Git arguments.
(define-syntax def-git-cmd-proxy
(syntax-rules ()
((_ f cmd pre-code process-result)
private/git-provider.rkt
+1 -38
View File
@@ -47,12 +47,6 @@
;; Provided functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Find the configured Git executable.
; pre : Git is on PATH or a valid executable can be selected interactively.
; post : The executable path has been cached.
; result : The path to git or git.exe.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (git-exe)
(-> (or/c path? #f))
(if (eq? cached-git-exe #f)
@@ -70,12 +64,6 @@
the-git-exe)
cached-git-exe))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Configure the Git executable.
; pre : exe-path names an executable path.
; post : The path has been stored and cached.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define/contract (set-git-exe! exe-path)
(-> path? void?)
(void
@@ -83,17 +71,9 @@
(cfg-set! 'git 'exe exe-path)
(set! cached-git-exe exe-path))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Run Git without allowing interactive terminal prompts.
; pre : args contains the Git command and its arguments.
; post : Standard output and error have been read completely.
; result : The exit code and ordered (source line) output items.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (run-git args)
(putenv "GIT_TERMINAL_PROMPT" "0")
(when (cfg-get 'git 'display-command #f)
(displayln
(string-join (cons "git" (map (lambda (arg) (format "~a" arg)) args)) " ")))
(let-values (((process stdout stdin stderr)
(apply subprocess
#f
@@ -143,12 +123,6 @@
(define (is-error? e)
(not (is-output? e)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Separate normal Git output from error output.
; pre : output contains (source line) items returned by run-git.
; post : output has only been inspected.
; result : Whether no error occurred and either normal or error lines.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-out cmd output)
(let* ((out (map (λ (e) (cadr e)) (filter (λ (e) (is-output? e)) output)))
(err (map (λ (e) (cadr e)) (filter (λ (e) (is-error? e)) output)))
@@ -156,11 +130,6 @@
)
(values r (if (eq? r #t) out err))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Log and raise a Git exception.
; pre : cmd, msg* and outp describe a failed Git command.
; post : The message has been logged and an exception has been raised.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax git-error
(syntax-rules ()
((_ cmd msg* outp)
@@ -184,12 +153,6 @@
(define re-a #px"~+")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Log Git output and optionally display it.
; pre : out is a string or a list of displayable lines.
; post : Non-empty output has been logged.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-displ out)
(let ((str (if (string? out) out (string-join out "\n"))))
(unless (string=? (string-trim str) "")
private/info.rkt
-18
View File
@@ -9,12 +9,6 @@
git-next-version
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read a package version from info.rkt.
; pre : dir contains a readable info.rkt.
; post : info.rkt has only been inspected.
; result : A list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (info-version dir)
(let* ((l (get-info/full dir))
(re #px"([0-9]+)[.]([0-9]+)([.]([0-9]+))?")
@@ -29,12 +23,6 @@
(cadddr (cdr m)))))
))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Store a package version in info.rkt.
; pre : dir contains info.rkt and version parts are numbers.
; post : The version definition has been replaced.
; result : #t after writing the file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (set-info-version! dir maj min patch)
(define (write-version fh)
@@ -66,12 +54,6 @@
#t)))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Increment a package version.
; pre : kind is maj, major, min, minor or patch.
; post : The version definition in info.rkt has been updated.
; result : #t after writing the new version.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-next-version kind . dir*)
(let ((dir (if (null? dir*)
"."