Documentation added and extended git log / git diif

This commit is contained in:
2026-08-13 11:12:08 +02:00
parent 9741b1cf51
commit f4f2c76ec6
9 changed files with 337 additions and 66 deletions
+3
View File
@@ -21,6 +21,9 @@
(deps clean)
(zip-package))
(target zip
(deps package))
(define doc-target "docs/git.html")
(define doc-src "scribblings/git.scrbl")
+1 -1
View File
@@ -2,7 +2,7 @@
(define collection "git-cli")
(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
(define version "0.3.11")
(define version "0.3.14")
(define pkg-authors '("Hans Dijkema"))
(define license 'MIT)
+183 -39
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,35 +198,103 @@
(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)
(if (eq? (hash-ref info 'file-output #f) #f)
(let ((diff (string-join
(filter (λ (line)
(not (string-prefix? (string-downcase line) "warning:")))
@@ -190,12 +302,17 @@
"\n")))
(diff->html diff)
#t)
#f)))
(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"))
+13
View File
@@ -43,11 +43,24 @@
;; 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)
+6
View File
@@ -11,6 +11,12 @@
(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")
+25 -8
View File
@@ -12,6 +12,12 @@
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; 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)))
@@ -28,6 +34,13 @@
(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)
@@ -51,10 +64,12 @@
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
@@ -65,10 +80,12 @@
)
;; 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)
+41
View File
@@ -47,6 +47,12 @@
;; 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)
@@ -64,6 +70,13 @@
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
@@ -72,6 +85,13 @@
(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")
(let-values (((process stdout stdin stderr)
@@ -123,6 +143,13 @@
(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)))
@@ -130,6 +157,13 @@
)
(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.
; result : No normal return value.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax git-error
(syntax-rules ()
((_ cmd msg* outp)
@@ -153,6 +187,13 @@
(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) "")
+20
View File
@@ -9,6 +9,12 @@
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]+))?")
@@ -23,6 +29,13 @@
(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)
@@ -54,6 +67,13 @@
#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*)
"."
+35 -8
View File
@@ -1,8 +1,8 @@
#lang scribble/manual
@(require (for-label racket/base
racket/contract
"../main.rkt"))
@;git-cli))
@title[#:tag "top"]{git-cli}
@author{Hans Dijkema}
@@ -10,18 +10,27 @@
@defmodule[git-cli]
The @racketmodname[git-cli] module provides a command-line-like Git interface
implemented by invoking the @tt{git} executable. Commands never read from
standard input.
implemented by invoking the @tt{git} executable. Commands do not allow Git to
read credentials or other answers from the terminal.
@section{Command interface}
@defform[(git command argument ...)]{
Runs a supported Git @racket[command]. The arguments are passed to the Git
command. Supported commands include @racket['status], @racket['add],
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['new-version].
Most registered commands invoke the Git command with the same name. Some
commands process the result into a Racket value, such as @racket['status],
@racket['grep], @racket['log] with @tt{--list}, @racket['version], and
@racket['new-version].
}
@section{Provided commands}
@defproc[(git-status [argument any/c] ...) list?]{
Runs @tt{git status --porcelain} with the supplied arguments.
@@ -37,7 +46,7 @@ Both statuses are one of @racket['unchanged], @racket['modified],
are @racket['untracked].
@racketblock[
((modified unchanged "staged.rkt")
'((modified unchanged "staged.rkt")
(unchanged modified "working-tree.rkt")
(modified modified "both.rkt")
(renamed unchanged "old.rkt -> new.rkt")
@@ -62,11 +71,27 @@ status zero; otherwise an exception is raised.
@defproc[(git-pull [argument any/c] ...) boolean?]{
Fetches and integrates changes. Normal progress written by Git to standard
error is treated as output when Git exits successfully.
error is accepted when Git exits successfully.
}
@defproc[(git-log [argument any/c] ...) boolean?]{
@defproc[(git-log [argument any/c] ...) (or/c boolean? list?)]{
Displays Git log output and returns @racket[#t] when Git exits successfully.
The git-cli-specific option @tt{--list}, or its short form @tt{-l}, changes the
result to a Racket list. Internally this option is replaced by Git's
@tt{--oneline} option. Each returned item contains the abbreviated commit id and
the commit subject.
@racketblock[
(git-log '--list '-5)
'(("003f371" "Diverse commando's toegevoegd. Ik weet nog niet of ik ze allemaal ga houden")
("2cb7e93" "Small changes. git main function is now a real function, not syntax"))
]
Other Git log options are still passed to Git. Consequently, options that add
extra output lines can also influence how useful @tt{--list} is as a structured
result.
}
@defproc[(git-grep [argument any/c] ...) list?]{
@@ -75,6 +100,8 @@ optional match count, and matched text. Exit status one means that no matches
were found and returns an empty list.
}
@section{Package version}
@defproc[(git-new-version [kind symbol?]) list?]{
Updates the version in @filepath{info.rkt}. The kind is @racket['major],
@racket['minor], or @racket['patch], with @racket['maj] and @racket['min] as