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

main.rkt

@@ -16,9 +16,37 @@
          git-commit
          git-pull
          git-push
+         git-fetch
+         git-branch
+         git-clone
          git-log
+         git-rev-list
+         git-diff
          git-grep
+         git-help
+         git-switch
+         git-restore
+         git-show
+         git-tag
+         git-stash
+         git-remote
+         git-init
+         git-current-branch
+         git-branches
+         git-remotes
+         git-tags
+         git-stashes
+         git-save
+         git-save-all
+         git-sync
+         git-start-branch
+         git-release
+         git-version
          git-new-version
+         git-exe
+         set-git-exe!
+         git-config
+         set-git-config!
          )
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -31,10 +59,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 +76,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 line entered by the user 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 +101,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 +121,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 output lines.
+; post   : The output 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)))
@@ -80,10 +134,37 @@
                  (string-contains? line* "no changes added to commit"))))
          out))
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Select the standard-output lines from ordered process output.
+; pre    : output contains (source line) items returned by run-git.
+; post   : The order of the selected lines has been preserved.
+; result : A list of standard-output lines.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (stdout-lines output)
+  (map cadr
+       (filter (lambda (entry) (eq? (car entry) 'stdout)) output)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Process a Git command whose useful result is a list of lines.
+; pre    : exit-code and output belong to the completed Git command.
+; post   : A non-zero exit code has raised a Git exception.
+; result : The standard-output lines when Git exits with status zero.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (process-lines-result cmd exit-code result output out info)
+  (if (= exit-code 0)
+      (stdout-lines output)
+      (git-error cmd (format "Exitcode <> 0: ~a" exit-code) out)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Command definition macro
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Define, register and connect a public Git command procedure.
+; pre    : The preprocessor and result processor use the 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)
@@ -91,8 +172,10 @@
     ((_ cmd cmd* cmd-sym pre-code)
      (def-cmd cmd cmd* cmd-sym pre-code std-process-git-result))
     ((_ cmd cmd* cmd-sym pre-code process-result)
+     (def-cmd cmd cmd* cmd-sym cmd-sym pre-code process-result))
+    ((_ cmd cmd* cmd-sym git-cmd pre-code process-result)
      (begin
-       (def-git-cmd-proxy cmd* cmd-sym
+       (def-git-cmd-proxy cmd* git-cmd
          pre-code
          process-result)
        (define (cmd . args) (cmd* args))
@@ -104,10 +187,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 file.
+; pre    : The current directory is inside a Git working tree.
+; post   : Git status has been invoked with --porcelain.
+; result : A list of (index-status worktree-status file) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (def-cmd git-status cmd-git-status 'status
   add-porcelain
   (λ (cmd exit-code result output out info)
@@ -119,23 +204,26 @@
                    (list (status->symbol (substring line 0 1))
                          (status->symbol (substring line 1 2))
                          (substring line 3))))
-             (map cadr
-                  (filter (λ (entry) (eq? (car entry) 'stdout)) output)))
+             (stdout-lines output))
         (git-error 'status "Exitcode <> 0" (cons (format "~a\n" exit-code) output))
         ))
   )
 
 
-;; 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   : A commit exists, 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,30 +242,68 @@
        (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   : Download refs and objects from a remote repository.
+; pre    : The supplied arguments are valid for git fetch.
+; post   : Git fetch has completed successfully or an exception has been raised.
+; result : #t after a successful fetch.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-fetch cmd-git-fetch 'fetch)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List, create or delete branches.
+; pre    : The supplied arguments are valid for git branch.
+; post   : Git branch has completed successfully or an exception has been 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 has been 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.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; 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   : 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 browser.
+; pre    : The supplied arguments are valid for git diff.
+; post   : A successful non-empty diff has been rendered as HTML.
+; result : #t for a rendered diff, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (def-cmd git-diff cmd-git-diff 'diff
   (λ (args info) args)
   (λ (cmd exit-code result output out info)
@@ -192,10 +318,12 @@
           #t)
           #f)))
 
-;; 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,39 +372,357 @@
             #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 has been raised.
+; result : #t after successfully displaying help.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (def-cmd git-help cmd-git-help 'help)
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Switch branches or restore working-tree files.
+; pre    : The supplied arguments are valid for git switch.
+; post   : Git switch has completed successfully or an exception was raised.
+; result : #t after a successful switch.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-switch cmd-git-switch 'switch)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Restore working-tree or index files.
+; pre    : The supplied arguments are valid for git restore.
+; post   : Git restore has completed successfully or an exception was raised.
+; result : #t after a successful restore.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-restore cmd-git-restore 'restore)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Display one or more Git objects.
+; pre    : The supplied arguments are valid for git show.
+; post   : Git show has completed successfully or an exception was raised.
+; result : #t after successfully displaying the objects.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-show cmd-git-show 'show)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : List, create, verify or delete tags.
+; pre    : The supplied arguments are valid for git tag.
+; post   : Git tag has completed successfully or an exception was raised.
+; result : #t after a successful tag command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-tag cmd-git-tag 'tag)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store or restore uncommitted changes.
+; pre    : The supplied arguments are valid for git stash.
+; post   : Git stash has completed successfully or an exception was raised.
+; result : #t after a successful stash command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-stash cmd-git-stash 'stash)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Manage the repositories whose branches are tracked.
+; pre    : The supplied arguments are valid for git remote.
+; post   : Git remote has completed successfully or an exception was raised.
+; result : #t after a successful remote command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-remote cmd-git-remote 'remote)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create an empty Git repository or reinitialize an existing one.
+; pre    : The supplied arguments are valid for git init.
+; post   : Git init has completed successfully or an exception was raised.
+; result : #t after a successful initialization.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-init cmd-git-init 'init)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Git information
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Obtain the name of the currently checked-out branch.
+; pre    : No arguments are supplied and the current directory is a repository.
+; post   : The repository has only been inspected.
+; result : The branch name, or #f when HEAD is detached.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-current-branch cmd-git-current-branch 'current-branch 'branch
+  (lambda (args info)
+    (unless (null? args)
+      (error 'git-current-branch "No arguments expected"))
+    (list '--show-current))
+  (lambda (cmd exit-code result output out info)
+    (let ((lines (process-lines-result cmd exit-code result output out info)))
+      (if (null? lines) #f (car lines)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Obtain the local branch names.
+; pre    : No arguments are supplied and the current directory is a repository.
+; post   : The repository has only been inspected.
+; result : A list of local branch names.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-branches cmd-git-branches 'branches 'branch
+  (lambda (args info)
+    (unless (null? args)
+      (error 'git-branches "No arguments expected"))
+    (list "--format=%(refname:short)"))
+  process-lines-result)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Obtain the configured remote names.
+; pre    : No arguments are supplied and the current directory is a repository.
+; post   : The repository has only been inspected.
+; result : A list of remote names.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-remotes cmd-git-remotes 'remotes 'remote
+  (lambda (args info)
+    (unless (null? args)
+      (error 'git-remotes "No arguments expected"))
+    args)
+  process-lines-result)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Obtain the repository tag names.
+; pre    : No arguments are supplied and the current directory is a repository.
+; post   : The repository has only been inspected.
+; result : A list of tag names.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-tags cmd-git-tags 'tags 'tag
+  (lambda (args info)
+    (unless (null? args)
+      (error 'git-tags "No arguments expected"))
+    (list '--list))
+  process-lines-result)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Convert one formatted stash line to a semantic list item.
+; pre    : line was produced by git stash list with the configured format.
+; post   : The line has only been inspected.
+; result : A list containing the stash reference and description.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (stash-line->result line)
+  (let ((m (regexp-match #px"^([^\t]+)\t(.*)$" line)))
+    (if m
+        (list (cadr m) (caddr m))
+        (list line ""))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Obtain stash references and descriptions.
+; pre    : No arguments are supplied and the current directory is a repository.
+; post   : The repository has only been inspected.
+; result : A list of (reference description) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(def-cmd git-stashes cmd-git-stashes 'stashes 'stash
+  (lambda (args info)
+    (unless (null? args)
+      (error 'git-stashes "No arguments expected"))
+    (list 'list "--format=%gd%x09%s"))
+  (lambda (cmd exit-code result output out info)
+    (map stash-line->result
+         (process-lines-result cmd exit-code result output out info))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Easy workflows
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Add selected paths and commit them with one message.
+; pre    : message is non-empty and at least one path is supplied.
+; post   : The paths have been staged and committed, or an exception was raised.
+; result : #t after a successful save.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-save message . files)
+  (when (string=? (string-trim (format "~a" message)) "")
+    (error 'git-save "A commit message is mandatory"))
+  (when (null? files)
+    (error 'git-save "At least one file is mandatory"))
+  (apply git-add files)
+  (git-commit '-m message))
+
+(hash-set! git-commands 'save
+           (lambda (args) (apply git-save args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Stage every change and commit it with one message.
+; pre    : message is non-empty.
+; post   : All changes have been staged and committed, or an exception was raised.
+; result : #t after a successful save.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-save-all message)
+  (when (string=? (string-trim (format "~a" message)) "")
+    (error 'git-save-all "A commit message is mandatory"))
+  (git-add '-A)
+  (git-commit '-m message))
+
+(hash-set! git-commands 'save-all
+           (lambda (args) (apply git-save-all args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Pull and then push a clean working tree.
+; pre    : Either no arguments or a remote and branch are supplied.
+; post   : Pull and push completed, or an exception was raised.
+; result : #t after a successful synchronization.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-sync . args)
+  (unless (or (null? args) (= (length args) 2))
+    (error 'git-sync "Expected no arguments or a remote and branch"))
+  (unless (null? (git-status))
+    (error 'git-sync "The working tree must be clean"))
+  (apply git-pull args)
+  (apply git-push args))
+
+(hash-set! git-commands 'sync
+           (lambda (args) (apply git-sync args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Create and switch to a new branch.
+; pre    : A name and at most one optional start point are supplied.
+; post   : The new branch is checked out, or an exception was raised.
+; result : #t after successfully creating the branch.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-start-branch name . start-point)
+  (when (> (length start-point) 1)
+    (error 'git-start-branch "Expected a name and optionally one start point"))
+  (apply git-switch (append (list '-c name) start-point)))
+
+(hash-set! git-commands 'start-branch
+           (lambda (args) (apply git-start-branch args)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Format a three-part version list as dotted text.
+; pre    : version contains major, minor and patch numbers.
+; post   : version has only been inspected.
+; result : The dotted version string.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (version->string version)
+  (string-join (map number->string version) "."))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Increment, commit and tag a clean package release.
+; pre    : kind is a supported version kind and the working tree is clean.
+; post   : info.rkt is committed and the release tag exists, or an exception occurred.
+; result : The created tag name.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-release kind)
+  (unless (null? (git-status))
+    (error 'git-release "The working tree must be clean"))
+  (let* ((version (git-new-version kind))
+         (version-text (version->string version))
+         (tag (string-append (git-config 'tag-prefix) version-text)))
+    (git-add "info.rkt")
+    (git-commit '-m (format "Version ~a" version-text))
+    (git-tag tag)
+    tag))
+
+(hash-set! git-commands 'release
+           (lambda (args) (apply git-release args)))
+
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; 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 empty.
+; post   : info.rkt has only been inspected.
+; result : A list containing major, minor and patch.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 (define (cmd-git-version args)
+  (unless (null? args)
+    (error 'git-version "No arguments expected"))
   (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"))
+  (unless (= (length args) 1)
+    (error 'git-new-version "Expected 'maj, 'major, 'min, 'minor or 'patch"))
   (let ((kind (car args)))
     (git-next-version kind ".")
     (git-version)))
 
 (hash-set! git-commands 'new-version cmd-git-new-version)
 
-
-
-
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Configuration
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return the default value for a public configuration key.
+; pre    : key is a supported public configuration key.
+; post   : Configuration has not been changed.
+; result : The default value for key.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-config-default key)
+  (case key
+    ((display-output) #t)
+    ((display-command) #f)
+    ((tag-prefix) "v")
+    (else (error 'git-config "Unknown configuration key: ~a" key))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Validate a value for a public configuration key.
+; pre    : key is a supported public configuration key.
+; post   : An invalid value has raised an exception.
+; result : The validated value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (validate-git-config key value)
+  (case key
+    ((display-output display-command)
+     (unless (boolean? value)
+       (error 'set-git-config! "~a must be a boolean" key)))
+    ((tag-prefix)
+     (unless (string? value)
+       (error 'set-git-config! "tag-prefix must be a string")))
+    (else (error 'set-git-config! "Unknown configuration key: ~a" key)))
+  value)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read a public git-cli configuration value.
+; pre    : key is display-output, display-command or tag-prefix.
+; post   : Configuration has not been changed.
+; result : The configured value or its default.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-config key)
+  (cfg-get (if (eq? key 'tag-prefix) 'release 'git)
+           key
+           (git-config-default key)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store a public git-cli configuration value.
+; pre    : key and value form a supported configuration setting.
+; post   : The setting has been persisted.
+; result : The stored value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-git-config! key value)
+  (cfg-set! (if (eq? key 'tag-prefix) 'release 'git)
+            key
+            (validate-git-config key value))
+  value)