Documentation added and extended git log / git diif
This commit is contained in:
@@ -21,6 +21,9 @@
|
||||
(deps clean)
|
||||
(zip-package))
|
||||
|
||||
(target zip
|
||||
(deps package))
|
||||
|
||||
(define doc-target "docs/git.html")
|
||||
(define doc-src "scribblings/git.scrbl")
|
||||
|
||||
|
||||
@@ -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)
|
||||
|
||||
|
||||
@@ -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"))
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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")
|
||||
|
||||
@@ -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)
|
||||
|
||||
@@ -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) "")
|
||||
|
||||
@@ -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*)
|
||||
"."
|
||||
|
||||
+39
-12
@@ -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,11 +46,11 @@ Both statuses are one of @racket['unchanged], @racket['modified],
|
||||
are @racket['untracked].
|
||||
|
||||
@racketblock[
|
||||
((modified unchanged "staged.rkt")
|
||||
(unchanged modified "working-tree.rkt")
|
||||
(modified modified "both.rkt")
|
||||
(renamed unchanged "old.rkt -> new.rkt")
|
||||
(untracked untracked "new.rkt"))
|
||||
'((modified unchanged "staged.rkt")
|
||||
(unchanged modified "working-tree.rkt")
|
||||
(modified modified "both.rkt")
|
||||
(renamed unchanged "old.rkt -> new.rkt")
|
||||
(untracked untracked "new.rkt"))
|
||||
]}
|
||||
|
||||
@defproc[(git-add [argument any/c] ...) boolean?]{
|
||||
@@ -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
|
||||
|
||||
Reference in New Issue
Block a user