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

Documentation added and extended git log / git diif

Browse Source
This commit is contained in:
Hans Dijkema
2026-08-13 11:12:08 +02:00
parent 9741b1cf51
commit f4f2c76ec6
9 changed files with 337 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files
main.rkt
+189 -45
View File
@@ -18,6 +18,12 @@
git-push
git-log
git-grep
git-branch
git-clone
git-rev-list
git-diff
git-help
git-version
git-new-version
)
@@ -31,10 +37,12 @@
;; Command invocation using 'git'
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; goal: Invoke a supported Git command through the command table.
;; pre: command is a registered Git command symbol.
;; post: The selected command has processed all supplied arguments.
;; result: The command-specific result.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Invoke a supported Git command through the command table.
; pre : command is a registered Git command symbol.
; post : The selected command has processed all supplied arguments.
; result : The command-specific result.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git command . args)
((hash-ref git-commands command
@@ -46,11 +54,23 @@
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Read one line of input after displaying a prompt.
; pre : p can be displayed.
; post : The prompt has been flushed before input is read.
; result : The entered line or an EOF object.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-prompt p)
(display p)
(flush-output)
(read-line))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Add --porcelain to a Git argument list when it is absent.
; pre : args is a list and an optional transformation accepts a list.
; post : Existing porcelain options have not been duplicated.
; result : The transformed Git argument list.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (add-porcelain args info . f)
(let ((m (has-git-arg? args #px"^[-][-]porcelain([=](.*))?"))
(g (if (null? f) (λ (x) x) (car f)))
@@ -59,6 +79,12 @@
(g args)
(g (cons '--porcelain args)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Convert one porcelain status character to a semantic symbol.
; pre : status is one Git porcelain v1 status character.
; post : Unknown status characters have raised an exception.
; result : The corresponding semantic status symbol.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (status->symbol status)
(cond
((string=? status " ") 'unchanged)
@@ -73,6 +99,12 @@
((string=? status "!") 'ignored)
(else (error 'git-status "Unexpected status: ~a" status))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Recognize Git output that reports there is nothing to commit.
; pre : out is a list of Git output lines.
; post : out has only been inspected.
; result : #t when a known nothing-to-commit message occurs, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (nothing-to-commit? out)
(ormap (λ (line)
(let ((line* (string-downcase line)))
@@ -84,6 +116,12 @@
;; Command definition macro
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Define and register a public Git command procedure.
; pre : pre-code and process-result follow the command proxy interfaces.
; post : cmd-sym is registered in the generic git command table.
; result : Definitions for the public and internal command procedures.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax def-cmd
(syntax-rules ()
((_ cmd cmd* cmd-sym)
@@ -104,10 +142,12 @@
;; Typical git commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; goal: Return the complete Git index and worktree status for every reported file.
;; pre: The current directory is inside a Git working tree.
;; post: Git status has been invoked with --porcelain.
;; result: A list containing (index-status worktree-status file) for every file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return the complete Git index and worktree status for every reported file.
; pre : The current directory is inside a Git working tree.
; post : Git status has been invoked with --porcelain.
; result : A list containing (index-status worktree-status file) for every file.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-status cmd-git-status 'status
add-porcelain
(λ (cmd exit-code result output out info)
@@ -126,16 +166,20 @@
)
;; goal: Add file contents to the Git index.
;; pre: The supplied arguments are valid for git add.
;; post: Git add has completed successfully or an exception has been raised.
;; result: #t after a successful Git command.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Add file contents to the Git index.
; pre : The supplied arguments are valid for git add.
; post : Git add has completed successfully or an exception has been raised.
; result : #t after a successful Git command.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-add cmd-git-add 'add)
;; goal: Create a Git commit.
;; pre: A commit message is supplied or can be requested from the user.
;; post: The commit was created, nothing needed committing, or an exception was raised.
;; result: #t after a commit or when the repository has nothing to commit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Create a Git commit.
; pre : A commit message is supplied or can be requested from the user.
; post : The commit was created, nothing needed committing, or an exception was raised.
; result : #t after a commit or when the repository has nothing to commit.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-commit cmd-git-commit 'commit
(λ (args info)
(with-handlers ([exn:fail? (λ (e)
@@ -154,48 +198,121 @@
(std-process-git-result cmd exit-code result output out info))))
)
;; goal: Push local changes to a remote repository.
;; pre: The supplied arguments are valid for git push.
;; post: Git push has completed successfully or an exception has been raised.
;; result: #t after a successful push.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Push local changes to a remote repository.
; pre : The supplied arguments are valid for git push.
; post : Git push has completed successfully or an exception has been raised.
; result : #t after a successful push.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-push cmd-git-push 'push add-porcelain)
;; goal: Fetch and integrate changes from a remote repository.
;; pre: The supplied arguments are valid for git pull.
;; post: Git pull has completed successfully or an exception has been raised.
;; result: #t after a successful pull.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Fetch and integrate changes from a remote repository.
; pre : The supplied arguments are valid for git pull.
; post : Git pull has completed successfully or an exception has been raised.
; result : #t after a successful pull.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-pull cmd-git-pull 'pull)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List, create or delete branches.
; pre : The supplied arguments are valid for git branch.
; post : Git branch has completed successfully or an exception was raised.
; result : #t after a successful branch command.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-branch cmd-git-branch 'branch)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Clone a repository into a new directory.
; pre : The supplied arguments are valid for git clone.
; post : The clone exists or an exception was raised.
; result : #t after a successful clone.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-clone cmd-git-clone 'clone)
;; goal: Display the Git commit log.
;; pre: The supplied arguments are valid for git log.
;; post: Git log has completed successfully or an exception has been raised.
;; result: #t after successfully displaying the log.
(def-cmd git-log cmd-git-log 'log)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Display the Git commit log or return it as a Racket list.
; pre : The supplied arguments are valid for git log; --list and -l are git-cli options.
; post : Git log has completed successfully or an exception has been raised.
; result : A list of (commit subject) items with --list/-l, otherwise #t.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-log cmd-git-log 'log
(λ (args info)
(map (λ (e)
(let ((o (format "~a" e)))
(cond
((or
(string=? o "--list")
(string=? o "-l"))
(begin
(hash-set! info 'scheme-format #t)
"--oneline"))
(else e))))
args))
(λ (cmd exit-code result output out info)
(if (hash-ref info 'scheme-format #f)
(if (and (= exit-code 0) result)
(let ((re #px"([0-9a-f]+)\\s+(.*)"))
(map (λ (line)
(let ((m (regexp-match re line)))
(if m
(list (cadr m) (caddr m))
(list #f line))))
out))
#f)
(std-process-git-result cmd exit-code result output out info)))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List commit objects reachable from supplied revisions.
; pre : The supplied arguments are valid for git rev-list.
; post : Git rev-list has completed successfully or an exception was raised.
; result : #t after successfully displaying the result.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-rev-list cmd-git-rev-list 'rev-list)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Render a Git diff in the default browser.
; pre : The supplied arguments are valid for git diff or
; are special cases like --output=-, --output=string.
; post : A successful diff has been rendered as HTML or
; to stdout/string.
; result : #t or a string when a diff was rendered, otherwise #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-diff cmd-git-diff 'diff
(λ (args info) args)
(λ (args info)
(hash-set! info 'file-output (has-git-arg? args #px"^[-][-]output[=]"))
(hash-set! info 'stdout (has-git-arg? args #px"^[-][-]output[=][-]"))
(hash-set! info 'string (has-git-arg? args #px"^[-][-]output[=]string"))
(if (or (hash-ref info 'stdout #f) (hash-ref info 'string #f))
(filter (λ (e) (not (has-git-arg? (list e) #px"^[-][-]output[=]([-]|string)"))) args)
args))
(λ (cmd exit-code result output out info)
(if (and (zero? exit-code)
result)
(let ((diff (string-join
(filter (λ (line)
(if (eq? (hash-ref info 'file-output #f) #f)
(let ((diff (string-join
(filter (λ (line)
(not (string-prefix? (string-downcase line) "warning:")))
out)
"\n")))
(diff->html diff)
#t)
#f)))
out)
"\n")))
(diff->html diff)
#t)
(if (hash-ref info 'string #f)
(string-join out "\n")
(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.
;; post: Git grep has completed; exit code one is treated as no matches.
;; result: A list containing file, line number, match count and matched text.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Search tracked files for a pattern.
; pre : The supplied arguments are valid for git grep.
; post : Git grep has completed; exit code one is treated as no matches.
; result : A list containing file, line number, match count and matched text.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-grep cmd-git-grep 'grep
(λ (args info)
(let ((matches #f)
@@ -244,6 +361,13 @@
#f))))
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Display help for Git or a Git command.
; pre : The supplied arguments are valid for git help.
; post : Git help has completed successfully or an exception was raised.
; result : #t after successfully displaying help.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-help cmd-git-help 'help)
@@ -251,21 +375,41 @@
;; Racket module versioning
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return the package version from info.rkt.
; pre : No arguments are required.
; post : info.rkt has only been inspected.
; result : A list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-version . args)
(cmd-git-version args))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Implement the registered version command.
; pre : args is the command argument list.
; post : info.rkt has only been inspected.
; result : A list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cmd-git-version args)
(info-version "."))
(hash-set! git-commands 'version cmd-git-version)
;; goal: Increment the package version in info.rkt.
;; pre: kind is 'maj, 'major, 'min, 'minor or 'patch.
;; post: The version definition in info.rkt has been updated.
;; result: The new version as a list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Increment the package version in info.rkt.
; pre : kind is 'maj, 'major, 'min, 'minor or 'patch.
; post : The version definition in info.rkt has been updated.
; result : The new version as a list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-new-version . args)
(cmd-git-new-version args))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Implement the registered new-version command.
; pre : args contains a supported version kind.
; post : The version definition in info.rkt has been updated.
; result : The new version as a list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (cmd-git-new-version args)
(when(null? args)
(error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch"))