Better documentation for git* and handling strings for symbols because of git*.

Ach kijk nou !

.gitignore

@@ -1,5 +1,9 @@
 /compiled
 /doc
-/*.bak
 /scribblings/compiled
 /tests/compiled
+/private/compiled
+
+/docs
+*~
+*.bak

Makefile

@@ -0,0 +1,51 @@
+#lang racket
+
+(require racket-makefile
+         package-zipper
+         net/sendurl
+         )
+
+
+(target all
+        (displayln "use (make clean) or (make package)")
+        )
+
+(target clean
+        (for-each (λ (f) (displayln f) (rm-f f)) (list-files "." #px"([.]bak|~)$" #:recursive #t))
+        (for-each (λ (d) (displayln d) (rm-rf d)) (list-dirs "." #px"(compiled|doc|docs)$" #:recursive #t))
+        (when (directory-exists? "scribblings")
+          (for-each (λ (f) (displayln f) (rm-f f)) (list-files "scribblings" #px"[.](css|js|html)$")))
+        )
+
+(target package
+        (deps clean)
+        (zip-package))
+
+(target zip
+        (deps package))
+
+(define doc-target "docs/git.html")
+(define doc-src "scribblings/git.scrbl")
+
+(target doc-target
+        (deps doc-src)
+        (unless (directory-exists? "docs")
+          (make-directory "docs"))
+        (raco '(scribble --html +m --dest "docs" $<)))
+
+(target doc
+        (deps doc-target)
+        (displayln "Documentation built")
+        )
+
+(target showdoc
+        (deps doc)
+        (send-url/file doc-target))
+
+(target refresh
+        (displayln "Refreshing makefile")
+        (refresh-makefile)
+        (displayln "done.")
+        )
+(target setup
+        (raco '(setup git)))

Makefile.rkt

@@ -1,21 +0,0 @@
-#lang racket
-
-(require racket-makefile
-         package-zipper
-         )
-
-
-(target all
-        (displayln "use (make clean) or (make package)")
-        )
-
-(target clean
-        (for-each (λ (f) (displayln f) (rm-f f)) (list-files "." #px"([.]bak|~)$" #:recursive #t))
-        (for-each (λ (d) (displayln d) (rm-rf d)) (list-dirs "." #px"(compiled|doc)$" #:recursive #t))
-        (for-each (λ (f) (displayln f) (rm-f f)) (list-files "scribblings" #px"[.](css|js|html)$"))
-        )
-
-(target package
-        (deps clean)
-        (zip-package))
-                 

README.md

@@ -1,100 +1,255 @@
-# git
+# git-cli
 
-A small command-line-like Git module for Racket, implemented directly on top of the `libgit2` package.
+A small command-line-like Git interface for Racket. The package invokes the
+installed `git` executable and exposes commands both through the generic `git`
+procedure and through direct procedures.
 
 ```racket
-(require git)
+(require git-cli)
 
+(git 'init)
 (git 'status)
+(git 'log '-l '-5)
+(git 'fetch '--prune)
+(git 'switch "main")
+(git 'tag "v0.3.16")
 (git 'diff)
-(git 'diff '--cached)
+(git 'show 'HEAD)
-(git 'add "main.rkt" "info.rkt")
-(git 'commit "Implement raco support")
-(git 'tag "v0.2")
-(git 'checkout "main")
 
-;; Display-oriented variant:
+(git-status)
-(dgit 'status)
+(git-fetch '--prune)
+(git-switch "main")
+(git-tag "v0.3.16")
 ```
 
-`git` is an ordinary procedure; command names are symbols. `dgit` performs the
+`git` is an ordinary procedure. The first argument is the Git command symbol
-same operation, displays a compact human-readable result, and returns that result.
+and the remaining arguments are passed to that command. Registered commands use
+their git-cli wrapper and can provide structured Racket results or additional
+behavior. Any other command is passed directly to the installed Git executable
+and handled with git-cli's standard command result processing.
 
-The same operations are available as normal procedures such as `git-status`, `git-add`, `git-commit`, `git-tag`, and `git-checkout`.
+For example, commands that do not have a dedicated wrapper can still be used:
-
-## HTTPS credentials
-
-Version 0.2 adds persistent HTTPS credentials.  They are stored in the
-`racket-git.ini` file in Racket's preferences directory.  Tokens are encrypted
-with AES-GCM using a key derived from the store password with
-PBKDF2-HMAC-SHA256.
-
-Create the credential store once:
 
 ```racket
-(git 'credentials 'init "store password")
+(git 'blame "main.rkt")
+(git* clean -n)
+(git* worktree list)
+(git* archive --format=zip HEAD)
 ```
 
-Store a token for a Git host:
+A successful fallback command returns `#t` after displaying normal Git output.
+A failing fallback command raises the same standard git-cli error as an ordinary
+pass-through wrapper.
+
+`git*` is the compact command-style syntax. Bare arguments are converted to
+strings, so `(git* remote get-url origin)` is equivalent to
+`(git 'remote "get-url" "origin")`. A bare identifier is therefore command-line
+text, not the value of a Racket variable or procedure with the same name. Use
+`(eval expression)` when an argument must come from a Racket expression.
+
+For example, `(git* switch branch)` passes the text `"branch"`, while
+`(git* switch (eval branch))` passes the value of the Racket variable `branch`.
+git-cli-specific wrappers should accept the textual arguments produced by
+`git*`; `new-version` accepts both symbols and text, so both
+`(git 'new-version 'min)` and `(git* new-version min)` work.
+
+`gt` remains available as a compatibility alias for `git*`.
 
 ```racket
-(git 'credentials 'set
+(git* init)
-     "https://git.dijkewijk.nl"
+(git* remote -v)
-     "hans"
+(git* switch main)
-     token)
+(git* restore --staged main.rkt)
+(git* reset --hard HEAD)
+(git* revert HEAD)
+(git* rebase main)
+(git* merge feature)
+(git* cherry-pick abc1234)
+(git* mergetool)
+
+(define branch "develop")
+(git* switch (eval branch))
 ```
 
-The host is used as the credential key, so the same entry is used for all HTTPS
+Several commands provide Racket-oriented output in addition to the normal Git
-repositories on that host.
+behavior:
 
-The store is unlocked for one day by default:
+- `git-status` uses Git's porcelain status and returns structured status items.
+- `git-log -l` / `git-log --list` returns `(commit subject)` items.
+- `git-tag -l` / `git-tag --list` returns tag names; with `-n` it returns `(tag subject)` items and `-n<number>` supports multiple content lines.
+- `git-branch -l` / `git-branch --list` returns `(current|local|remote branch)` items; `-a`, `-r`, and `--sort=` remain Git options.
+- `git-remote` returns remote names; `git-remote -v` / `git-remote --verbose` returns separate `(name url fetch|push)` items.
+- `git-stash list` returns `(stash-name description)` items; other stash subcommands keep Git's normal behavior.
+- `git-restore`, `git-reset`, `git-revert`, `git-rebase`, `git-merge`, and `git-cherry-pick` pass Git's command syntax through unchanged.
+- `git-mergetool` uses Git's mergetool interface and prefers a configured or well-known graphical merge tool.
+- `git-diff` renders HTML by default; `--output=-` selects stdout and
+  `--output=string` returns a string.
+- `git-show` renders a commit and its diff as HTML by default. `-l` /
+  `--list` provides structured variants for `--stat`, `--name-only`, and
+  `--name-status`.
+
+Git is searched on `PATH`. Git itself remains responsible for remotes,
+credentials, SSH keys, pull strategy, and other repository configuration.
+
+## Commands
+
+The package registers wrappers for commands where git-cli adds useful behavior,
+including `init`, `status`, `add`, `commit`, `push`, `pull`, `fetch`, `config`,
+`branch`, `remote`, `stash`, `restore`, `reset`, `revert`, `rebase`, `merge`,
+`cherry-pick`, `mergetool`, `switch`, `clone`, `tag`, `log`, `rev-list`, `diff`,
+`show`, `grep`, `help`, `version`, and `new-version`. Other Git commands do not
+need a wrapper and are passed directly to Git.
+
+Most registered commands are also exported as direct procedures such as
+`git-init`, `git-status`, `git-add`, `git-fetch`, `git-config`, `git-switch`,
+`git-tag`, `git-log`, `git-diff`, and `git-show`.
+
+See the Scribble documentation for command-specific behavior and return values.
+
+## Git configuration
+
+`git config` has a small Racket-oriented interface:
 
 ```racket
-(git 'credentials 'unlock "store password")
+(git 'config '--all)
+(git 'config 'get '--all)
+(git 'config '--global 'get '--all)
+(git 'config 'get '--global "user.email")
+(git 'config 'get '--all "credential.helper")
+(git 'config 'get "credential.helper")
+(git 'config 'set! "user.email" "hans@example.invalid")
+(git 'config '--global 'set! "user.email" "hans@example.invalid")
+(git 'config 'set! '--global "user.email" "hans@example.invalid")
 ```
 
-or for an explicit number of seconds:
+`get --all` without a key returns `(key value)` items. `get --all key`
+returns all values for one key. `get key` returns one string or `#f` when the
+key is absent. `set!` returns `#t` after a successful write.
+
+
+`config editor` is a git-cli configuration command rather than a Git
+configuration key. With no additional arguments it presents an interactive
+list of discovered GUI editors:
 
 ```racket
-(git 'credentials 'unlock "store password" (* 8 60 60))
+(git* config editor)
 ```
 
-The temporary unlock state is stored in `racket-git-unlock.ini` in Racket's
+The non-interactive forms are:
-preferences directory, so it survives restarting DrRacket and starting a new
-Racket process.  Both files are opened through `simple-ini` with `#:private? #t`; on Unix this
-restricts them to mode 0600 before sensitive contents are written.  The cached
-derived key grants access to the credentials until its expiry,
-so `racket-git-unlock.ini` must be treated as sensitive during that period.
-
-Lock immediately with:
 
 ```racket
-(git 'credentials 'lock)
+(git* config editor --list)
+(git* config editor --downloads)
+(git* config editor vscode)
+(git* config editor notepad++)
+(git* config editor auto)
+
+(git 'config 'editor "C:\\Program Files\\MyEditor\\editor.exe --wait")
 ```
 
-After credentials have been stored and the store is unlocked, normal remote
+`--list` returns `(name description command current?)` items and `--downloads`
-operations use them automatically:
+returns official download pointers for optional editors. A known editor name
+selects the matching detected editor. `auto` clears the explicit git-cli editor
+choice and returns to automatic detection. Any other single value is stored as
+the editor command. Changing the editor immediately updates `GIT_EDITOR` and
+`GIT_SEQUENCE_EDITOR` for subsequent Git commands.
+
+On Windows, Notepad++ is detected both on `PATH` and in the normal Program Files
+locations. It is started with `-multiInst -nosession`, so Git waits for the
+separate editor instance to close.
+
+
+`config mergetool` uses the same git-cli configuration pattern:
 
 ```racket
-(git 'fetch)
+(git* config mergetool)
-(git 'pull)
+(git* config mergetool --list)
-(git 'push)
+(git* config mergetool --downloads)
-
+(git* config mergetool winmerge)
-;; Suppress network progress when desired:
+(git* config mergetool auto)
-(git 'push #:quiet #t)
 ```
 
-## Supported Git operations
+`--list` returns `(name description path current?)` items. A known tool name
+selects the detected tool, while another single value is stored as the Git
+mergetool name. `auto` clears the explicit git-cli choice and returns to
+automatic detection. The interactive form also offers download/install
+suggestions.
 
-Version 0.2 supports repository discovery, init, clone, status, add, config,
+## Low-level Git execution
-commit, branch, checkout, lightweight tags, log, remotes, fetch,
-fast-forward-only pull, push, tag push, network transfer progress, and HTTPS username/token credentials.
 
-SSH credentials, merge/rebase pull, annotated tags, and submodules are not yet
+`run-git` can be used when direct access to Git's stdin/stdout protocol is
-part of this module.
+needed. Optional text can be supplied to Git with `#:input`.
 
-Install from the package directory with:
+```racket
-
+(run-git '(credential fill)
-```sh
+         #:input "protocol=https\nhost=git.dijkewijk.nl\n\n")
-raco pkg install .
+```
+
+The result remains two values: Git's exit code and the ordered
+`(source line)` output items.
+
+## Authentication retry
+
+Authentication failures are recognized centrally after `run-git`. The
+recognizer covers common authentication/authorization errors, including HTTP
+401 and 403 responses.
+
+`current-git-authentication-handler` defaults to
+`default-git-authentication-handler`. After an authentication failure the
+default handler rejects the failed credential first. If a Git credential
+helper exists, `git credential fill` is then tried so that helpers such as Git
+Credential Manager can obtain a replacement credential.
+
+When no usable credential is returned, git-cli asks for a username and
+password/token using `input-prompt`. The `#:loop-until` callbacks validate the
+input and return the final value, as intended by `input-prompt`. If no
+credential helper is configured, git-cli configures the non-persistent `cache`
+helper locally before approving the supplied credential.
+
+The original Git command is retried once. If authentication fails again, the
+credential used for that retry is rejected before the normal Git error is
+raised. This prevents a bad token from remaining in the credential cache.
+
+A custom handler can still be installed through
+`current-git-authentication-handler`.
+
+
+## GUI editor and merge tool
+
+When git-cli is loaded, it configures the current Racket process once for the
+Git commands it starts. `GIT_TERMINAL_PROMPT` is set to `0`. When a GUI editor
+is found, `GIT_EDITOR` and `GIT_SEQUENCE_EDITOR` are set to that editor command.
+`run-git` itself no longer copies or rewrites the process environment.
+
+The editor can be inspected or configured explicitly:
+
+```racket
+(find-editor)
+(find-editors)
+(set-editor! "code --wait")
+(set-editor-auto!)
+```
+
+The editor search first checks `PATH` and then well-known platform locations.
+On Windows this includes the normal per-user and Program Files locations for
+VS Code and Notepad++, with Notepad as fallback. On macOS the standard Visual Studio Code
+application bundle and TextEdit are recognized. On Linux common `/usr`,
+`/usr/local`, and Snap locations are checked for VS Code, Kate, Gedit, and Xed.
+
+`git-mergetool` stays on top of Git's own mergetool mechanism. If no tool is
+specified explicitly, git-cli prefers a configured or well-known graphical
+tool such as WinMerge, Meld, KDiff3, VS Code, TortoiseMerge, or opendiff.
+The finder checks `PATH` first and then common platform installation locations.
+`find-mergetool-path` can be used to inspect the executable that was found.
+If no tool is found, Git is left to select its own default.
+
+```racket
+(find-mergetool)
+(find-mergetools)
+(find-mergetool-path)
+(mergetool-downloads)
+(set-mergetool! "winmerge")
+(set-mergetool-auto!)
+(git* mergetool)
+(git* mergetool --tool=meld)
 ```

credentials.rkt

@@ -1,230 +0,0 @@
-#lang racket/base
-
-(require crypto
-         crypto/all
-         net/base64
-         racket/file
-         racket/string
-         simple-ini)
-
-(provide git-credentials-store
-         git-credentials-unlock-store
-         current-git-credentials-store
-         current-git-credentials-unlock-store
-         git-credentials-init!
-         git-credentials-unlock!
-         git-credentials-lock!
-         git-credentials-unlocked?
-         git-credentials-unlock-expires
-         git-credentials-set!
-         git-credentials-ref
-         git-credentials-configured?
-         git-credentials-remove!)
-
-(define git-credentials-store 'racket-git)
-(define git-credentials-unlock-store 'racket-git-unlock)
-
-;; Parameters make the storage location overridable for tests or embedded use,
-;; while the public default remains the normal Racket preference stores.
-(define current-git-credentials-store (make-parameter git-credentials-store))
-(define current-git-credentials-unlock-store (make-parameter git-credentials-unlock-store))
-
-(define settings-section 'settings)
-(define unlock-section 'unlock)
-(define kdf-iterations 200000)
-(define cipher '(aes gcm))
-(define check-text #"racket-git credential store")
-
-(define-syntax-rule (with-git-crypto body ...)
-  (parameterize ([crypto-factories all-factories])
-    body ...))
-
-(define (b64-encode bytes)
-  (bytes->string/utf-8 (base64-encode bytes #"")))
-
-(define (b64-decode string)
-  (base64-decode (string->bytes/utf-8 string)))
-
-(define (store-read name)
-  (file->ini name))
-
-(define (store-write name ini)
-  (make-directory* (find-system-path 'pref-dir))
-  (ini->file ini name #:private? #t)
-  (void))
-
-(define (store-set! name section key value)
-  (define ini (store-read name))
-  (ini-set! ini section key value)
-  (store-write name ini))
-
-(define (store-get name section key [default #f])
-  (ini-get (store-read name) section key default))
-
-(define (derive-key password salt)
-  (with-git-crypto
-    (pbkdf2-hmac 'sha256
-                 (string->bytes/utf-8 password)
-                 salt
-                 #:iterations kdf-iterations
-                 #:key-size 32)))
-
-(define (encrypt-value key plaintext aad)
-  (with-git-crypto
-    (define iv (generate-cipher-iv cipher))
-    (define encrypted
-      (encrypt cipher key iv (string->bytes/utf-8 plaintext)
-               #:aad (string->bytes/utf-8 aad)))
-    (string-append (b64-encode iv) ":" (b64-encode encrypted))))
-
-(define (decrypt-value key encoded aad)
-  (with-git-crypto
-    (define parts (string-split encoded ":"))
-    (unless (= (length parts) 2)
-      (error 'git-credentials "invalid encrypted credential data"))
-    (bytes->string/utf-8
-     (decrypt cipher key
-              (b64-decode (car parts))
-              (b64-decode (cadr parts))
-              #:aad (string->bytes/utf-8 aad)))))
-
-(define (credential-key remote)
-  (define url-match
-    (regexp-match #px"^[A-Za-z][A-Za-z0-9+.-]*://(?:[^/@]+@)?([^/:]+)" remote))
-  (define ssh-match
-    (regexp-match #px"^[^@]+@([^:]+):" remote))
-  (string-downcase
-   (cond
-     [url-match (cadr url-match)]
-     [ssh-match (cadr ssh-match)]
-     [else remote])))
-
-(define (string->hex string)
-  (apply string-append
-         (for/list ([b (in-bytes (string->bytes/utf-8 string))])
-           (let ([h (number->string b 16)])
-             (if (= (string-length h) 1) (string-append "0" h) h)))))
-
-(define (credential-section remote)
-  ;; simple-ini deliberately accepts a conservative section-name syntax.
-  ;; Hex keeps arbitrary host names reversible and section-safe.
-  (string->symbol (string-append "credential."
-                                 (string->hex (credential-key remote)))))
-
-(define (git-credentials-init! password #:unlock-for [seconds 86400])
-  (unless (and (string? password) (positive? (string-length password)))
-    (raise-argument-error 'git-credentials-init! "non-empty string?" password))
-  (define existing-salt (store-get (current-git-credentials-store) settings-section 'salt #f))
-  (when existing-salt
-    (error 'git-credentials-init! "credential store is already initialized"))
-  (define salt (with-git-crypto (crypto-random-bytes 16)))
-  (define key (derive-key password salt))
-  (define ini (store-read (current-git-credentials-store)))
-  (ini-set! ini settings-section 'version 1)
-  (ini-set! ini settings-section 'kdf "pbkdf2-hmac-sha256")
-  (ini-set! ini settings-section 'iterations kdf-iterations)
-  (ini-set! ini settings-section 'salt (b64-encode salt))
-  (ini-set! ini settings-section 'check
-            (encrypt-value key (bytes->string/utf-8 check-text) "check"))
-  (store-write (current-git-credentials-store) ini)
-  (cache-unlock-key! key seconds)
-  (void))
-
-(define (cache-unlock-key! key seconds)
-  (unless (and (real? seconds) (> seconds 0))
-    (raise-argument-error 'git-credentials-unlock! "positive real?" seconds))
-  (define ini (store-read (current-git-credentials-unlock-store)))
-  (ini-set! ini unlock-section 'key (b64-encode key))
-  (ini-set! ini unlock-section 'expires (+ (current-seconds) seconds))
-  (store-write (current-git-credentials-unlock-store) ini)
-  (void))
-
-(define (git-credentials-unlock! password #:for [seconds 86400])
-  (define salt-text (store-get (current-git-credentials-store) settings-section 'salt #f))
-  (define check (store-get (current-git-credentials-store) settings-section 'check #f))
-  (unless (and salt-text check)
-    (error 'git-credentials-unlock! "credential store is not initialized"))
-  (define key (derive-key password (b64-decode salt-text)))
-  (with-handlers ([exn:fail?
-                   (lambda (_)
-                     (error 'git-credentials-unlock! "invalid password"))])
-    (unless (string=? (decrypt-value key check "check")
-                      (bytes->string/utf-8 check-text))
-      (error 'git-credentials-unlock! "invalid password")))
-  (cache-unlock-key! key seconds)
-  (void))
-
-(define (git-credentials-lock!)
-  (define ini (store-read (current-git-credentials-unlock-store)))
-  (ini-set! ini unlock-section 'key "")
-  (ini-set! ini unlock-section 'expires 0)
-  (store-write (current-git-credentials-unlock-store) ini)
-  (void))
-
-(define (git-credentials-unlock-expires)
-  (define expires (store-get (current-git-credentials-unlock-store) unlock-section 'expires 0))
-  (if (number? expires) expires 0))
-
-(define (git-credentials-unlocked?)
-  (define key (store-get (current-git-credentials-unlock-store) unlock-section 'key ""))
-  (define expires (git-credentials-unlock-expires))
-  (cond
-    [(and (string? key)
-          (not (string=? key ""))
-          (> expires (current-seconds)))
-     #t]
-    [else
-     (when (and (number? expires) (positive? expires))
-       (git-credentials-lock!))
-     #f]))
-
-(define (current-key who)
-  (unless (git-credentials-unlocked?)
-    (error who "credential store 'racket-git is locked"))
-  (b64-decode
-   (store-get (current-git-credentials-unlock-store) unlock-section 'key "")))
-
-(define (git-credentials-set! remote username token)
-  (unless (string? remote)
-    (raise-argument-error 'git-credentials-set! "string?" remote))
-  (unless (string? username)
-    (raise-argument-error 'git-credentials-set! "string?" username))
-  (unless (string? token)
-    (raise-argument-error 'git-credentials-set! "string?" token))
-  (define key (current-key 'git-credentials-set!))
-  (define section (credential-section remote))
-  (define ini (store-read (current-git-credentials-store)))
-  (ini-set! ini section 'username username)
-  (ini-set! ini section 'token
-            (encrypt-value key token (string-append (credential-key remote) ":" username)))
-  (store-write (current-git-credentials-store) ini)
-  (void))
-
-(define (git-credentials-configured? remote)
-  (define section (credential-section remote))
-  (define username (store-get (current-git-credentials-store) section 'username #f))
-  (define encrypted (store-get (current-git-credentials-store) section 'token #f))
-  (and (string? username) (not (string=? username ""))
-       (string? encrypted) (not (string=? encrypted ""))))
-
-(define (git-credentials-ref remote)
-  (define section (credential-section remote))
-  (define username (store-get (current-git-credentials-store) section 'username #f))
-  (define encrypted (store-get (current-git-credentials-store) section 'token #f))
-  (cond
-    [(and (string? username) (not (string=? username ""))
-          (string? encrypted) (not (string=? encrypted "")))
-     (define key (current-key 'git-credentials-ref))
-     (cons username
-           (decrypt-value key encrypted (string-append (credential-key remote) ":" username)))]
-    [else #f]))
-
-(define (git-credentials-remove! remote)
-  ;; simple-ini has no section-delete primitive.  Clearing both values keeps
-  ;; the file format simple and makes git-credentials-ref return #f.
-  (define section (credential-section remote))
-  (define ini (store-read (current-git-credentials-store)))
-  (ini-set! ini section 'username "")
-  (ini-set! ini section 'token "")
-  (store-write (current-git-credentials-store) ini)
-  (void))

info.rkt

@@ -1,22 +1,24 @@
 #lang info
 
-(define collection "git")
+(define collection "git-cli")
-(define pkg-desc "Command-line-like Git operations for Racket, implemented with libgit2")
+(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
-(define version "0.2.6")
+(define version "0.4.2")
 (define pkg-authors '("Hans Dijkema"))
 (define license 'MIT)
 
 (define deps
   '("base"
-    "libgit2"
+    "simple-ini"
-    ("simple-ini" #:version "0.3.3")
+    "simple-log"
-    "crypto-lib"
+    "racket-index"
-    "net-lib"))
+    "scribble-lib"
+    "net-lib"
+    ))
 
 (define build-deps
   '("rackunit-lib"
-    "scribble-lib"
     "racket-doc"))
 
 (define scribblings
-  '(("scribblings/git.scrbl" () ("Git"))))
+  '(("scribblings/git-cli.scrbl" () ("git-cli"))))
+

private/config.rkt

@@ -0,0 +1,68 @@
+#lang racket/base
+
+(require simple-ini/class
+         simple-log
+         )
+
+(provide cfg-get
+         cfg-set!
+         dbg-git
+         info-git
+         err-git
+         warn-git
+         fatal-git
+         sync-log-git
+         )
+
+(sl-def-log git)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal state / functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define ini #f)
+
+(define (check-ini)
+  (when (eq? ini #f)
+    (set! ini (new ini% [file 'git-cli]))))
+
+(define mutex (make-semaphore 1))
+
+(define-syntax critical
+  (syntax-rules ()
+    ((_ b1 ...)
+     (dynamic-wind
+      (λ () (semaphore-wait mutex))
+      (λ () b1 ...)
+      (λ () (semaphore-post mutex)))
+     )
+    )
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store one git-cli configuration value.
+; pre    : section and key identify a simple-ini setting.
+; post   : value has been persisted.
+; result : The result returned by simple-ini.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (cfg-set! section key value)
+  (critical
+   (check-ini)
+   (send ini set! section key value)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read one git-cli configuration value.
+; pre    : section and key identify a simple-ini setting.
+; post   : Configuration has not been changed.
+; result : The stored value or default-value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (cfg-get section key default-value)
+  (critical
+   (check-ini)
+   (send ini get section key default-value)))
+

private/diff.rkt

@@ -0,0 +1,161 @@
+#lang racket/base
+
+(require net/sendurl
+         racket/list
+         json
+         xml
+         racket/string
+         "config.rkt"
+         "utils.rkt"
+         )
+
+(provide diff->html
+         show->html
+         config-diff2html
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Helper functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (make-js . args)
+  (string-join args "\n"))
+
+(define (highlight-css)
+  (cfg-get 'diff 'highlight-css
+           "https://cdnjs.cloudflare.com/ajax/libs/highlight.js/11.8.0/styles/github.min.css")
+  )
+
+(define (diff2html-min-css)
+  (cfg-get 'diff 'diff2html-min-css
+           "https://cdn.jsdelivr.net/npm/diff2html/bundles/css/diff2html.min.css")
+  )
+
+(define (diff2html-ui-min-js)
+  (cfg-get 'diff 'diff2html-ui-min-js
+           "https://cdn.jsdelivr.net/npm/diff2html/bundles/js/diff2html-ui.min.js")
+  )
+
+(define (diff-script diff)
+  (format
+   (make-js
+    "window.do_diff = function() {"
+    "const diff = ~a;"
+    "const ui = new Diff2HtmlUI("
+    "                   document.getElementById('diff'),"
+    "                   diff,"
+    "                   {"
+    "                     drawFileList: true,"
+    "                     matching: 'lines',"
+    "                     outputFormat: 'side-by-side',"
+    "                   });"
+    "ui.draw();"
+    "ui.highlightCode();"
+    "};"
+    )
+   (jsexpr->string diff))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Exported functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (config-diff2html)
+
+  (define (checker f)
+    (λ (inp)
+      (let ((url (string-trim inp)))
+        (if (string=? url "")
+            (f)
+            (if (valid-http-or-file-url? url)
+                url
+                (begin
+                  (displayln "! Not a valid url, please input a valid url")
+                  #f)))))
+    )
+
+  (define (inp name f)
+    (input-prompt (string-join
+                   (list
+                    (format "Give the url for the ~a" name)
+                    "Enter keeps the current value:"
+                    (string-append " - " (f))
+                    ">")
+                   "\n")
+                  #:loop-until (checker f)))
+    
+    (let ((h-css (inp "Highlighting CSS" highlight-css))
+          (d-css (inp "Diff2Html CSS" diff2html-min-css))
+          (d-js (inp "Diff2Html UI Javascript" diff2html-ui-min-js))
+          )
+      (cfg-set! 'diff 'highlight-css h-css)
+      (cfg-set! 'diff 'diff2html-min-css d-css)
+      (cfg-set! 'diff 'diff2html-ui-min-js d-js))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; 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 ((html `(html
+                (head
+                 (meta ((charset "utf-8")))
+                 (link ((rel "stylesheet") (href ,(highlight-css))))
+                 (link ((rel "stylesheet") (href ,(diff2html-min-css))))
+                 (script ((src ,(diff2html-ui-min-js))) "")
+                 (script ,(diff-script diff))
+                 )
+                (body
+                 (div ((id "diff")))
+                 (script ((type "text/javascript"))
+                         "window.do_diff();")
+                 ))))
+    (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-diff.html")))
+      (call-with-output-file tmp-file #:exists 'truncate
+        (λ (out)
+          (display (xexpr->string html) out)))
+      (send-url/file tmp-file))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Render git show output as commit information followed by a diff.
+; pre    : show is the textual output produced by git show.
+; post   : The generated HTML file has been opened in the default browser.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (show->html show)
+  (let* ((lines (string-split show "\n" #:trim? #f))
+         (diff-pos (let loop ((rest lines)
+                              (n 0))
+                     (cond
+                       ((null? rest) #f)
+                       ((string-prefix? (car rest) "diff --git ") n)
+                       (else (loop (cdr rest) (+ n 1))))))
+         (header (string-join (if diff-pos (take lines diff-pos) lines) "\n"))
+         (diff (string-join (if diff-pos (drop lines diff-pos) '()) "\n"))
+         (html `(html
+                 (head
+                  (meta ((charset "utf-8")))
+                  (link ((rel "stylesheet") (href ,(highlight-css))))
+                  (link ((rel "stylesheet") (href ,(diff2html-min-css))))
+                  (style "body { font-family: sans-serif; margin: 1.5em; } pre.commit { white-space: pre-wrap; }")
+                  ,@(if diff-pos
+                        `((script ((src ,(diff2html-ui-min-js))) "")
+                          (script ,(diff-script diff)))
+                        '())
+                  )
+                 (body
+                  (pre ((class "commit")) ,header)
+                  ,@(if diff-pos
+                        `((div ((id "diff")))
+                          (script ((type "text/javascript"))
+                                  "window.do_diff();"))
+                        '())
+                  ))))
+    (let ((tmp-file (build-path (find-system-path 'temp-dir) "racket-git-show.html")))
+      (call-with-output-file tmp-file #:exists 'truncate
+        (λ (out)
+          (display (xexpr->string html) out)))
+      (send-url/file tmp-file))))

private/find-editor.rkt

@@ -0,0 +1,273 @@
+#lang racket/base
+
+(require racket/path
+         racket/string
+         "config.rkt")
+
+(provide find-editor
+         find-editors
+         editor-downloads
+         configured-editor
+         set-editor!
+         set-editor-auto!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Quote an executable path for use as a Git editor command.
+; pre    : p is a path to an executable.
+; post   : p has only been converted to a string.
+; result : A quoted command path.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (quote-command-path p)
+  (format "\"~a\"" (path->string p)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build a path below an environment variable when it is defined.
+; pre    : variable is an environment variable name.
+; post   : The environment has only been inspected.
+; result : The constructed path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (environment-path variable . parts)
+  (let ((base (getenv variable)))
+    (if base
+        (apply build-path base parts)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Make an editor description from an executable path.
+; pre    : p is a path or #f; arguments contains any required wait arguments.
+; post   : The filesystem has only been inspected.
+; result : (name description command), or #f when the executable does not exist.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-at name description p arguments)
+  (if (and p (file-exists? p))
+      (list name
+            description
+            (string-append (quote-command-path p) arguments))
+      #f))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find an editor executable on PATH.
+; pre    : executable is a pathless executable name.
+; post   : PATH has only been inspected.
+; result : (name description command), or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-on-path name description executable arguments)
+  (let ((p (find-executable-path executable)))
+    (editor-at name description p arguments)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Remove duplicate editor descriptions while preserving preference order.
+; pre    : editors contains editor descriptions or #f values.
+; post   : editors has only been inspected.
+; result : One editor description per editor name.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (unique-editors editors)
+  (let loop ((remaining editors)
+             (names '())
+             (result '()))
+    (cond
+      ((null? remaining)
+       (reverse result))
+      ((not (car remaining))
+       (loop (cdr remaining) names result))
+      (else
+       (let* ((editor (car remaining))
+              (name (car editor)))
+         (if (member name names)
+             (loop (cdr remaining) names result)
+             (loop (cdr remaining)
+                   (cons name names)
+                   (cons editor result))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return known GUI editors found on Windows.
+; pre    : The current platform is Windows.
+; post   : PATH and standard Windows installation locations were inspected.
+; result : A list of editor descriptions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-windows-editors)
+  (unique-editors
+   (list
+    (editor-on-path "vscode" "Visual Studio Code" "code.cmd" " --wait")
+    (editor-on-path "vscode" "Visual Studio Code" "code.exe" " --wait")
+    (editor-at
+     "vscode"
+     "Visual Studio Code"
+     (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
+     " --wait")
+    (editor-at
+     "vscode"
+     "Visual Studio Code"
+     (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
+     " --wait")
+    (editor-at
+     "vscode"
+     "Visual Studio Code"
+     (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd")
+     " --wait")
+    (editor-on-path "notepad++"
+                    "Notepad++"
+                    "notepad++.exe"
+                    " -multiInst -nosession")
+    (editor-at
+     "notepad++"
+     "Notepad++"
+     (environment-path "ProgramFiles" "Notepad++" "notepad++.exe")
+     " -multiInst -nosession")
+    (editor-at
+     "notepad++"
+     "Notepad++"
+     (environment-path "ProgramFiles(x86)" "Notepad++" "notepad++.exe")
+     " -multiInst -nosession")
+    (editor-on-path "notepad" "Notepad" "notepad.exe" "")
+    (editor-at
+     "notepad"
+     "Notepad"
+     (environment-path "SystemRoot" "System32" "notepad.exe")
+     ""))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return known GUI editors found on macOS.
+; pre    : The current platform is macOS.
+; post   : PATH and standard application locations were inspected.
+; result : A list of editor descriptions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-macos-editors)
+  (unique-editors
+   (list
+    (editor-on-path "vscode" "Visual Studio Code" "code" " --wait")
+    (editor-at
+     "vscode"
+     "Visual Studio Code"
+     (string->path
+      "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code")
+     " --wait")
+    (let ((open
+           (or (find-executable-path "open")
+               (let ((p (string->path "/usr/bin/open")))
+                 (if (file-exists? p) p #f)))))
+      (if open
+          (list "textedit"
+                "TextEdit"
+                (format "~a -W -a TextEdit" (quote-command-path open)))
+          #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return known GUI editors found on Unix/Linux.
+; pre    : The current platform is Unix.
+; post   : PATH and common Linux installation locations were inspected.
+; result : A list of editor descriptions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-unix-editors)
+  (unique-editors
+   (list
+    (editor-on-path "vscode" "Visual Studio Code" "code" " --wait")
+    (editor-on-path "kate" "Kate" "kate" " --block")
+    (editor-on-path "gedit" "Gedit" "gedit" " --wait")
+    (editor-on-path "xed" "Xed" "xed" " --wait")
+    (editor-at "vscode" "Visual Studio Code" (string->path "/snap/bin/code") " --wait")
+    (editor-at "vscode" "Visual Studio Code" (string->path "/usr/local/bin/code") " --wait")
+    (editor-at "vscode" "Visual Studio Code" (string->path "/usr/bin/code") " --wait")
+    (editor-at "kate" "Kate" (string->path "/usr/local/bin/kate") " --block")
+    (editor-at "kate" "Kate" (string->path "/usr/bin/kate") " --block")
+    (editor-at "gedit" "Gedit" (string->path "/usr/bin/gedit") " --wait")
+    (editor-at "xed" "Xed" (string->path "/usr/bin/xed") " --wait"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Set the editor environment variables for Git commands started by git-cli.
+; pre    : command is a valid Git editor command.
+; post   : GIT_EDITOR and GIT_SEQUENCE_EDITOR contain command.
+; result : command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-editor-environment! command)
+  (putenv "GIT_EDITOR" command)
+  (putenv "GIT_SEQUENCE_EDITOR" command)
+  command)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return all well-known GUI editors found on the current platform.
+; pre    : The platform and filesystem are available.
+; post   : No editor has been started.
+; result : A list of (name description command) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-editors)
+  (case (system-type 'os)
+    ((windows) (find-windows-editors))
+    ((macosx) (find-macos-editors))
+    ((unix) (find-unix-editors))
+    (else '())))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return official download pointers for optional GUI editors.
+; pre    : The current platform is known.
+; post   : No network request has been made.
+; result : A list of (name description url) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (editor-downloads)
+  (case (system-type 'os)
+    ((windows)
+     '(("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")
+       ("notepad++" "Notepad++" "https://notepad-plus-plus.org/downloads/")))
+    ((macosx)
+     '(("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    ((unix)
+     '(("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    (else '())))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the editor explicitly configured for git-cli.
+; pre    : The git-cli configuration is readable.
+; post   : The configuration has not been changed.
+; result : The configured editor command, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (configured-editor)
+  (let ((editor (cfg-get 'git 'editor #f)))
+    (if (and (string? editor)
+             (not (string=? (string-trim editor) "")))
+        editor
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store and activate the editor command used by git-cli.
+; pre    : command is a command string suitable for GIT_EDITOR.
+; post   : The command has been stored and applied to the Git editor environment.
+; result : command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-editor! command)
+  (cfg-set! 'git 'editor command)
+  (set-editor-environment! command))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return git-cli to automatic editor detection and activate that editor.
+; pre    : A well-known GUI editor can be found on the current platform.
+; post   : The explicit editor setting is cleared and the detected editor is active.
+; result : The automatically detected editor command.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-editor-auto!)
+  (let ((editors (find-editors)))
+    (if (null? editors)
+        (error 'git-config "No well-known GUI editor found")
+        (begin
+          (cfg-set! 'git 'editor "")
+          (set-editor-environment! (caddr (car editors)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the GUI editor that git-cli should offer to Git.
+; pre    : The platform and git-cli configuration are available.
+; post   : No editor has been started.
+; result : A configured or well-known GUI editor command, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-editor)
+  (or (configured-editor)
+      (let ((editors (find-editors)))
+        (if (null? editors)
+            #f
+            (caddr (car editors))))))

private/find-mergetool.rkt

@@ -0,0 +1,306 @@
+#lang racket/base
+
+(require racket/path
+         "config.rkt")
+
+(provide find-mergetool
+         find-mergetools
+         find-mergetool-path
+         mergetool-downloads
+         configured-mergetool
+         set-mergetool!
+         set-mergetool-auto!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build a path below an environment variable when it is defined.
+; pre    : variable is an environment variable name.
+; post   : The environment has only been inspected.
+; result : The constructed path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (environment-path variable . parts)
+  (let ((base (getenv variable)))
+    (if base
+        (apply build-path base parts)
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find one merge tool candidate on PATH or at a well-known path.
+; pre    : candidate contains tool name, executable name and zero or more paths.
+; post   : PATH and the filesystem have only been inspected.
+; result : A list containing tool name and executable path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-candidate candidate)
+  (let* ((tool (car candidate))
+         (executable (cadr candidate))
+         (path-executable (find-executable-path executable)))
+    (cond
+      (path-executable
+       (list tool path-executable))
+      (else
+       (let loop ((paths (cddr candidate)))
+         (cond
+           ((null? paths) #f)
+           ((and (car paths)
+                 (file-exists? (car paths)))
+            (list tool (car paths)))
+           (else
+            (loop (cdr paths)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the first usable merge tool candidate.
+; pre    : candidates contains merge tool candidate descriptions.
+; post   : PATH and the filesystem have only been inspected.
+; result : A list containing tool name and executable path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-candidates candidates)
+  (cond
+    ((null? candidates) #f)
+    (else
+     (let ((candidate (find-candidate (car candidates))))
+       (if candidate
+           candidate
+           (find-candidates (cdr candidates)))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return every usable merge tool candidate without duplicate tool names.
+; pre    : candidates contains merge tool candidate descriptions.
+; post   : PATH and the filesystem have only been inspected.
+; result : A list of (tool description path) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-all-candidates candidates)
+  (let loop ((remaining candidates)
+             (names '())
+             (result '()))
+    (cond
+      ((null? remaining)
+       (reverse result))
+      (else
+       (let ((candidate (find-candidate (car remaining))))
+         (cond
+           ((not candidate)
+            (loop (cdr remaining) names result))
+           ((member (car candidate) names)
+            (loop (cdr remaining) names result))
+           (else
+            (loop (cdr remaining)
+                  (cons (car candidate) names)
+                  (cons
+                   (list (car candidate)
+                         (mergetool-description (car candidate))
+                         (cadr candidate))
+                   result)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for Windows.
+; pre    : Windows environment variables may or may not be defined.
+; post   : The environment has only been inspected.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return a display description for a known Git merge tool.
+; pre    : tool is a Git merge tool name.
+; post   : tool has only been inspected.
+; result : A human-readable description.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mergetool-description tool)
+  (cond
+    ((string=? tool "winmerge") "WinMerge")
+    ((string=? tool "vscode") "Visual Studio Code")
+    ((string=? tool "kdiff3") "KDiff3")
+    ((string=? tool "meld") "Meld")
+    ((string=? tool "tortoisemerge") "TortoiseMerge")
+    ((string=? tool "opendiff") "FileMerge / opendiff")
+    (else tool)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for Windows.
+; pre    : Windows environment variables may or may not be defined.
+; post   : The environment has only been inspected.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (windows-mergetool-candidates)
+  (list
+   (list "winmerge" "WinMergeU.exe"
+         (environment-path "ProgramFiles" "WinMerge" "WinMergeU.exe")
+         (environment-path "ProgramFiles(x86)" "WinMerge" "WinMergeU.exe"))
+   (list "vscode" "code.cmd"
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd"))
+   (list "vscode" "code.exe"
+         (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles" "Microsoft VS Code" "Code.exe")
+         (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "Code.exe"))
+   (list "kdiff3" "kdiff3.exe"
+         (environment-path "ProgramFiles" "KDiff3" "kdiff3.exe")
+         (environment-path "ProgramFiles(x86)" "KDiff3" "kdiff3.exe"))
+   (list "meld" "meld.exe"
+         (environment-path "LOCALAPPDATA" "Programs" "Meld" "Meld.exe")
+         (environment-path "ProgramFiles" "Meld" "Meld.exe")
+         (environment-path "ProgramFiles(x86)" "Meld" "Meld.exe"))
+   (list "tortoisemerge" "TortoiseMerge.exe"
+         (environment-path "ProgramFiles" "TortoiseSVN" "bin" "TortoiseMerge.exe")
+         (environment-path "ProgramFiles(x86)" "TortoiseSVN" "bin" "TortoiseMerge.exe"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for macOS.
+; pre    : The current platform is macOS.
+; post   : No program has been started.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (macos-mergetool-candidates)
+  (list
+   (list "opendiff" "opendiff"
+         (string->path "/usr/bin/opendiff"))
+   (list "vscode" "code"
+         (string->path
+          "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code"))
+   (list "kdiff3" "kdiff3"
+         (string->path "/Applications/kdiff3.app/Contents/MacOS/kdiff3"))
+   (list "meld" "meld")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return well-known graphical merge tool candidates for Unix/Linux.
+; pre    : The current platform is Unix.
+; post   : No program has been started.
+; result : Merge tool candidate descriptions in preference order.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (unix-mergetool-candidates)
+  (list
+   (list "meld" "meld"
+         (string->path "/usr/bin/meld")
+         (string->path "/usr/local/bin/meld"))
+   (list "kdiff3" "kdiff3"
+         (string->path "/usr/bin/kdiff3")
+         (string->path "/usr/local/bin/kdiff3"))
+   (list "vscode" "code"
+         (string->path "/snap/bin/code")
+         (string->path "/usr/bin/code")
+         (string->path "/usr/local/bin/code"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return merge tool candidates for the current platform.
+; pre    : The current platform is supported by Racket.
+; post   : No program has been started.
+; result : Merge tool candidate descriptions.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mergetool-candidates)
+  (case (system-type 'os)
+    ((windows) (windows-mergetool-candidates))
+    ((macosx) (macos-mergetool-candidates))
+    ((unix) (unix-mergetool-candidates))
+    (else '())))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the automatically detected merge tool and executable path.
+; pre    : Platform paths are accessible.
+; post   : No merge tool has been started.
+; result : A list containing tool name and path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (detected-mergetool)
+  (find-candidates (mergetool-candidates)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the merge tool explicitly configured for git-cli.
+; pre    : The git-cli configuration is readable.
+; post   : The configuration has not been changed.
+; result : The configured Git merge tool name, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return all well-known merge tools found on the current platform.
+; pre    : The platform and filesystem are available.
+; post   : No merge tool has been started.
+; result : A list of (name description path) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-mergetools)
+  (find-all-candidates (mergetool-candidates)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return official download pointers for optional merge tools.
+; pre    : The current platform is known.
+; post   : No network request has been made.
+; result : A list of (name description url) items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (mergetool-downloads)
+  (case (system-type 'os)
+    ((windows)
+     '(("winmerge" "WinMerge" "https://winmerge.org/downloads/")
+       ("kdiff3" "KDiff3" "https://apps.kde.org/kdiff3/")
+       ("meld" "Meld" "https://meldmerge.org/")
+       ("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    ((macosx)
+     '(("kdiff3" "KDiff3" "https://apps.kde.org/kdiff3/")
+       ("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    ((unix)
+     '(("meld" "Meld" "https://meldmerge.org/")
+       ("kdiff3" "KDiff3" "https://apps.kde.org/kdiff3/")
+       ("vscode" "Visual Studio Code" "https://code.visualstudio.com/download")))
+    (else '())))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (configured-mergetool)
+  (let ((tool (cfg-get 'git 'mergetool #f)))
+    (if (and (string? tool)
+             (not (string=? tool "")))
+        tool
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Store the Git merge tool name used by git-cli.
+; pre    : tool is a Git mergetool name such as "winmerge" or "meld".
+; post   : The tool name has been stored in the git-cli configuration.
+; result : The result returned by the configuration layer.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-mergetool! tool)
+  (cfg-set! 'git 'mergetool tool))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Return git-cli to automatic merge tool detection.
+; pre    : A well-known merge tool can be found on the current platform.
+; post   : The explicit merge tool setting is cleared.
+; result : The automatically detected Git merge tool name.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (set-mergetool-auto!)
+  (let ((detected (detected-mergetool)))
+    (if detected
+        (begin
+          (cfg-set! 'git 'mergetool "")
+          (car detected))
+        (error 'git-config "No well-known merge tool found"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the graphical merge tool that git-cli should prefer.
+; pre    : The platform and git-cli configuration are available.
+; post   : No merge tool has been started.
+; result : A configured or detected Git merge tool name, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-mergetool)
+  (or (configured-mergetool)
+      (let ((detected (detected-mergetool)))
+        (if detected
+            (car detected)
+            #f))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Find the executable path belonging to the automatically detected merge tool.
+; pre    : Platform paths are accessible.
+; post   : No merge tool has been started.
+; result : The executable path, or #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (find-mergetool-path)
+  (let ((tool (find-mergetool)))
+    (if tool
+        (let loop ((tools (find-mergetools)))
+          (cond
+            ((null? tools) #f)
+            ((string=? tool (car (car tools)))
+             (caddr (car tools)))
+            (else
+             (loop (cdr tools)))))
+        #f)))

private/git-auth.rkt

@@ -0,0 +1,287 @@
+#lang racket/base
+
+(require racket/string
+         net/url
+         "git-provider.rkt"
+         "utils.rkt")
+
+(provide exn:fail:git-auth?
+         exn:fail:git-auth-command
+         exn:fail:git-auth-args
+         exn:fail:git-auth-exit-code
+         exn:fail:git-auth-output
+         authentication-failure?
+         raise-git-auth-error
+         default-git-authentication-handler
+         reject-git-authentication
+         current-git-authentication-handler)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authentication exception
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(struct exn:fail:git-auth exn:fail
+  (command args exit-code output)
+  #:transparent)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Read the first value of a Git configuration key.
+; pre    : key is a Git configuration key.
+; post   : Git config has been queried without displaying its output.
+; result : The configured value, or #f when the key is absent.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-config-value key)
+  (let-values (((exit-code output)
+                (run-git (list 'config '--get key))))
+    (if (= exit-code 0)
+        (let ((stdout
+               (map cadr
+                    (filter (λ (entry) (eq? (car entry) 'stdout))
+                            output))))
+          (if (null? stdout) #f (car stdout)))
+        #f)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Determine the remote name used by the current branch.
+; pre    : The current directory is a Git working tree.
+; post   : Git branch/config have only been queried.
+; result : The configured remote name, or "origin" as fallback.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-current-remote)
+  (let-values (((exit-code output)
+                (run-git '(branch --show-current))))
+    (if (= exit-code 0)
+        (let ((stdout
+               (map cadr
+                    (filter (λ (entry) (eq? (car entry) 'stdout))
+                            output))))
+          (if (null? stdout)
+              "origin"
+              (let ((remote
+                     (git-config-value
+                      (format "branch.~a.remote" (car stdout)))))
+                (if remote remote "origin"))))
+        "origin")))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Determine the remote URL relevant to the failed Git command.
+; pre    : cmd and args belong to a failed authenticated Git command.
+; post   : Git config has only been queried.
+; result : An HTTP(S) remote URL, or #f when it cannot be determined.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-authentication-url cmd args)
+  (let* ((remote (git-current-remote))
+         (url (git-config-value (format "remote.~a.url" remote))))
+    (if url
+        url
+        (git-config-value "remote.origin.url"))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Convert an HTTP(S) remote URL to Git credential input.
+; pre    : value is a URL string.
+; post   : value has only been parsed.
+; result : protocol, host and optional username, or #f values for unsupported URLs.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (url->credential-parts value)
+  (with-handlers ((exn:fail? (λ (e) (values #f #f #f))))
+    (let* ((u (string->url value))
+           (protocol (url-scheme u))
+           (host (url-host u))
+           (user (url-user u)))
+      (if (and (member protocol '("http" "https"))
+               (string? host)
+               (not (string=? host "")))
+          (values protocol host user)
+          (values #f #f #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Build Git credential protocol input.
+; pre    : protocol and host are strings; username and password may be #f.
+; post   : Arguments have only been formatted.
+; result : A credential protocol string terminated by a blank line.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (credential-input protocol host username password)
+  (string-append
+   (format "protocol=~a\n" protocol)
+   (format "host=~a\n" host)
+   (if username (format "username=~a\n" username) "")
+   (if password (format "password=~a\n" password) "")
+   "\n"))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ask Git's configured credential helper for credentials.
+; pre    : protocol and host identify the failed HTTP(S) remote.
+; post   : The helper may have prompted or updated its own credential state.
+; result : #t when git credential fill succeeded, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-credential-fill protocol host username)
+  (let-values (((exit-code output)
+                (run-git '(credential fill)
+                         #:input (credential-input protocol host username #f))))
+    (= exit-code 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Offer credentials to Git's configured credential helper.
+; pre    : protocol, host, username and password describe a credential.
+; post   : Git credential approve has been invoked.
+; result : #t when Git accepted the approve operation, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-credential-approve protocol host username password)
+  (let-values (((exit-code output)
+                (run-git '(credential approve)
+                         #:input (credential-input protocol host username password))))
+    (= exit-code 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Reject credentials for an HTTP(S) remote through Git.
+; pre    : protocol and host identify the credential; username may be #f.
+; post   : Git credential reject has been invoked.
+; result : #t when Git accepted the reject operation, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (git-credential-reject protocol host username)
+  (let-values (((exit-code output)
+                (run-git '(credential reject)
+                         #:input (credential-input protocol host username #f))))
+    (= exit-code 0)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ensure a non-persistent credential helper exists for this repository.
+; pre    : The current directory is inside a Git working tree.
+; post   : credential.helper=cache is configured locally when no helper existed.
+; result : #t when a helper exists or was configured, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (ensure-credential-helper)
+  (let ((helper (git-config-value "credential.helper")))
+    (if helper
+        #t
+        (let-values (((exit-code output)
+                      (run-git '(config --local credential.helper cache))))
+          (= exit-code 0)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ask the user for credentials and approve them through Git.
+; pre    : protocol and host identify an HTTP(S) remote.
+; post   : Supplied credentials have been offered to Git's helper.
+; result : #t when credentials were approved, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (ask-and-approve-credential protocol host username)
+  (let* ((username*
+          (if username
+              username
+              (input-prompt
+               (format "Username for ~a: " host)
+               #:loop-until
+               (λ (value)
+                 (cond
+                   ((eof-object? value)
+                    (error 'git-authentication "Input cancelled"))
+                   ((string=? (string-trim value) "")
+                    #f)
+                   (else
+                    (string-trim value)))))))
+         (password
+          (input-prompt
+           (format "Password/token for ~a: " host)
+           #:loop-until
+           (λ (value)
+             (cond
+               ((eof-object? value)
+                (error 'git-authentication "Input cancelled"))
+               ((string=? value "")
+                #f)
+               (else
+                value))))))
+    (and (ensure-credential-helper)
+         (git-credential-approve protocol host username* password))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Authentication handling
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Recognize output that indicates Git authentication failed.
+; pre    : exit-code and output belong to a completed Git command.
+; post   : output has only been inspected.
+; result : #t when a known authentication failure is present, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define auth-recognizer
+  #px"(authentication failed|failed to authenticate|could not read (username|password)|access denied|terminal prompts disabled|requested url returned error: (401|403))")
+
+(define (authentication-failure? exit-code output)
+  (and (not (= exit-code 0))
+       (ormap
+        (λ (entry)
+          (let ((line (string-downcase (format "~a" (cadr entry)))))
+            (regexp-match? auth-recognizer line)))
+        output)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Raise a Git authentication exception containing the failed invocation.
+; pre    : cmd, args, exit-code and output describe a failed Git command.
+; post   : An exn:fail:git-auth exception has been raised.
+; result : No normal return value.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (raise-git-auth-error cmd args exit-code output)
+  (let ((msg (format "git ~a: authentication failed" cmd)))
+    (raise
+     (exn:fail:git-auth msg
+                        (current-continuation-marks)
+                        cmd
+                        args
+                        exit-code
+                        output))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Reject the credential associated with a failed Git command.
+; pre    : cmd and args identify a failed authenticated Git invocation.
+; post   : Git's credential helper has been asked to forget the credential.
+; result : #t when a credential could be identified and rejected, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (reject-git-authentication cmd args)
+  (let ((url (git-authentication-url cmd args)))
+    (if (not url)
+        #f
+        (let-values (((protocol host username)
+                      (url->credential-parts url)))
+          (if protocol
+              (git-credential-reject protocol host username)
+              #f)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Resolve an authentication failure using Git first, then input-prompt.
+; pre    : cmd, args and e describe one failed Git invocation.
+; post   : Git's helper has been tried; a missing helper may be configured locally.
+; result : #t when retrying the original command is meaningful, otherwise #f.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (default-git-authentication-handler cmd args e)
+  (let ((url (git-authentication-url cmd args)))
+    (if (not url)
+        #f
+        (let-values (((protocol host username)
+                      (url->credential-parts url)))
+          (if (not protocol)
+              #f
+              (let ((helper (git-config-value "credential.helper")))
+                (when helper
+                  (git-credential-reject protocol host username))
+                (if (and helper
+                         (git-credential-fill protocol host username))
+                    #t
+                    (ask-and-approve-credential
+                     protocol host username))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Supply the callback that can resolve an authentication failure.
+; pre    : The callback accepts command, arguments and an exn:fail:git-auth value.
+; post   : The callback is used by command proxies before one authentication retry.
+; result : A parameter containing the current authentication callback.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define current-git-authentication-handler
+  (make-parameter default-git-authentication-handler))

private/git-commands.rkt

@@ -0,0 +1,128 @@
+#lang racket/base
+
+(require "git-provider.rkt"
+         "git-auth.rkt"
+         racket/string
+         racket/list
+         )
+
+(provide def-git-cmd-proxy
+         check-git-args
+         has-git-arg?
+         std-process-git-result
+         default-git-authentication-handler
+         current-git-authentication-handler
+         exn:fail:git-auth?
+         exn:fail:git-auth-command
+         exn:fail:git-auth-args
+         exn:fail:git-auth-exit-code
+         exn:fail:git-auth-output
+         )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; 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)))
+                   ((regexp? opt) (λ (x) (regexp-match opt (format "~a" x))))
+                   (else (error "opt must be a string, symbol or regular expression")))))
+    (letrec ((f (λ (args)
+                  (if (null? args)
+                      #f
+                      (let ((m (cmp (car args))))
+                        (if m
+                            m
+                            (f (cdr args))))))))
+      (if (list? args)
+          (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)
+     (let ((flag (car opt))
+           (num-args (cadr opt))
+           (err-msg (caddr opt)))
+       (letrec ((find (λ (l)
+                        (if (null? l)
+                            #f
+                            (if (eq? (car l) flag)
+                                (if  (>= (length (cdr l)) num-args)
+                                     #t
+                                     #f)
+                                (find (cdr l)))))))
+         (let ((found (find args)))
+           (unless found
+             (error 'git (format "git ~a: ~a" cmd err-msg))))
+         )
+       ))
+   flags)
+  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.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (std-process-git-result cmd exit-code result output out info)
+  (if (= exit-code 0)
+      (begin
+        (git-displ (map cadr output))
+        #t)
+      (git-error cmd (format "Exitcode <> 0: ~a" exit-code) out)
+      )
+  )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Define the internal proxy for a Git command.
+; pre    : pre-code and process-result accept the command proxy arguments.
+; post   : Authentication failures are offered once to the current authentication
+;          handler before the Git command is retried.
+; 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)
+     (define (f args*)
+       (let* ((args (flatten args*))
+              (info (make-hash))
+              (nargs (pre-code args info)))
+         (let retry ((authentication-retry? #t))
+           (with-handlers
+               ((exn:fail:git-auth?
+                 (λ (e)
+                   (if authentication-retry?
+                       (if ((current-git-authentication-handler) cmd nargs e)
+                           (retry #f)
+                           (git-error cmd
+                                      (format "Exitcode <> 0: ~a"
+                                              (exn:fail:git-auth-exit-code e))
+                                      (exn:fail:git-auth-output e)))
+                       (begin
+                         (reject-git-authentication cmd nargs)
+                         (git-error cmd
+                                    (format "Exitcode <> 0: ~a"
+                                            (exn:fail:git-auth-exit-code e))
+                                    (exn:fail:git-auth-output e)))))))
+             (let-values (((exit-code output) (run-git (cons cmd nargs))))
+               (when (authentication-failure? exit-code output)
+                 (raise-git-auth-error cmd nargs exit-code output))
+               (let-values (((result out) (git-out cmd output)))
+                 (process-result cmd exit-code result output out info))))))))
+    )
+  )

private/git-provider.rkt

@@ -0,0 +1,232 @@
+#lang racket/base
+
+(require racket/path
+         racket/string
+         racket/contract
+         racket/system
+         "config.rkt"
+         "find-editor.rkt"
+         )
+
+(provide git-exe
+         set-git-exe!
+         run-git
+         git-out
+         git-error
+         git-displ
+         )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Supporting functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define cached-git-exe #f)
+
+(define (ask-for-git-executable)
+  (displayln "Git was not found on PATH.")
+  (displayln "Enter the full path to git/git.exe, or press Enter to abort:")
+  (let loop ()
+    (display "> ")
+    (flush-output)
+    (let ((answer (read-line)))
+      (when (or (eof-object? answer)
+                (string=? (string-trim answer) ""))
+        (error 'git "Git executable not found; configuration aborted"))
+      (let ((candidate (find-executable-path answer)))
+        (if (eq? candidate #f)
+            (begin
+              (displayln
+               (format "'~a' is not found, please try again or press Enter to abort." answer))
+               (loop))
+            (begin
+              (set-git-exe! candidate)
+              #t)))))
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; 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)
+      (let ((the-git-exe (let ((exe (cfg-get 'git 'exe #f)))
+                           (if (eq? exe #f)
+                               (let ((path (find-executable-path "git")))
+                                 (if (eq? path #f)
+                                     (if (ask-for-git-executable)
+                                         (git-exe)
+                                         #f)
+                                     path))
+                               exe
+                               ))))
+        (set! cached-git-exe the-git-exe)
+        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
+   (begin
+     (cfg-set! 'git 'exe exe-path)
+     (set! cached-git-exe exe-path))))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Run Git without allowing interactive terminal prompts.
+; pre    : args contains the Git command and its arguments; input is #f or a string
+;          that must be written to Git's standard input.
+; post   : Optional input has been written and standard output and error have been
+;          read completely.
+; result : The exit code and ordered (source line) output items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Configure the process environment used by git-cli Git commands.
+; pre    : The editor finder can inspect the current platform.
+; post   : Terminal prompting is disabled and a detected GUI editor is made
+;          available to Git and Git's sequence editor.
+; result : void.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (setup-git-environment!)
+  (putenv "GIT_TERMINAL_PROMPT" "0")
+  (let ((editor (find-editor)))
+    (when editor
+      (putenv "GIT_EDITOR" editor)
+      (putenv "GIT_SEQUENCE_EDITOR" editor)))
+  (void))
+
+(setup-git-environment!)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Run Git without allowing interactive terminal prompts.
+; pre    : args contains the Git command and its arguments; input is #f or a string
+;          that must be written to Git's standard input.
+; post   : Optional input has been written and standard output and error have been
+;          read completely.
+; result : The exit code and ordered (source line) output items.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (run-git args #:input (input #f))
+  (let-values (((process stdout stdin stderr)
+                (apply subprocess
+                       #f
+                       #f
+                       #f
+                       (git-exe)
+                       (map (λ (arg) (format "~a" arg)) args)
+                       )))
+    (when input
+      (display input stdin)
+      (flush-output stdin))
+    (close-output-port stdin)
+    (let ((output-channel (make-channel)))
+      (define (read-output source port)
+        (thread
+         (λ ()
+           (let loop ()
+             (let ((line (read-line port)))
+               (channel-put output-channel (list source line))
+               (if (eof-object? line)
+                   (close-input-port port)
+                   (loop)))))))
+
+      (read-output 'stdout stdout)
+      (read-output 'stderr stderr)
+
+      (let loop ((open-ports 2)
+                 (result '()))
+        (if (= open-ports 0)
+            (begin
+              (subprocess-wait process)
+              (values (subprocess-status process)
+                      (reverse result)))
+            (let* ((output (channel-get output-channel))
+                   (line (cadr output)))
+              (if (eof-object? line)
+                  (loop (- open-ports 1) result)
+                  (loop open-ports
+                        (cons output result)))))))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Provided utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (is-output? e)
+  (or (eq? (car e) 'stdout)
+      (and (eq? (car e) 'stderr)
+           (string-prefix? (string-downcase (cadr e)) "warning:"))))
+
+(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)))
+         (r (null? err))
+         )
+    (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)
+     (let* ((out (map (λ (e) (if (list? e)
+                                 (if (null? e)
+                                     ""
+                                     (if (or (eq? (car e) 'stdout)
+                                             (eq? (car e) 'stderr))
+                                         (format "~a" (cadr e))
+                                         (format "~a" e)))
+                                 (format "~a" e)))
+                      (if (list? outp) outp (list outp))))
+            (enter (if (eq? (system-type 'os) 'windows) "\n" "\n"))
+            (msg (format "git ~a: ~a: ~a" cmd msg* (string-join out enter)))
+            )
+       (err-git msg)
+       (error 'git msg))
+     )
+    )
+  )
+
+(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) "")
+      (let ((s (regexp-replace* re-a str "~~")))
+        (info-git s))
+      (when (cfg-get 'git 'display-output #t)
+        (displayln str)))))

private/info-handler.rkt

@@ -0,0 +1,102 @@
+#lang racket/base
+
+(require setup/getinfo
+         racket/string
+         )
+
+(provide info-version
+         set-info-version!
+         info-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]+))?")
+         (v (with-handlers ([exn:fail?
+                             (λ (e) "0.1")])
+              (l 'version)))
+         (m (regexp-match re v))
+         )
+    (map string->number
+         (list (cadr m) (caddr m) (if (eq? (cadddr (cdr m)) #f)
+                                      "0"
+                                      (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)
+    (let ((str (if (= patch 0)
+                   (format "(define version \"~a.~a\")" maj min)
+                   (format "(define version \"~a.~a.~a\")" maj min patch))))
+      (unless (eq? fh #f)
+        (displayln str fh))
+      str))
+
+  (let ((info-file (build-path dir "info.rkt")))
+    (unless (file-exists? info-file)
+      (error (format "No info.rkt exists at ~a" info-file)))
+    
+    (let ((fh (open-input-file info-file)))
+      (letrec ((reader (λ ()
+                         (let ((line (read-line fh)))
+                           (if (eof-object? line)
+                               '()
+                               (cons line (reader)))))))
+        (let* ((text (string-join (reader) "\n")))
+          (close-input-port fh)
+          (let* ((re #px"[(]define\\s+version\\s+[\"][^\"]+[\"]\\s*[)]")
+                 (ntext (regexp-replace re text (write-version #f)))
+                 (fout (open-output-file info-file #:exists 'replace))
+                 )
+            (display ntext fout)
+            (close-output-port fout)
+            #t)))))
+  )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Increment a package version.
+; pre    : kind represents maj, major, min, minor or patch as symbol or text.
+; post   : The version definition in info.rkt has been updated.
+; result : #t after writing the new version.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(define (info-next-version kind . dir*)
+  (let ((dir (if (null? dir*)
+                 "."
+                 (car dir*)))
+        (kind* (string->symbol (format "~a" kind))))
+    (if (memq kind* '(maj major min minor patch))
+        (let ((v (info-version dir)))
+          (cond
+            ((or (eq? kind* 'maj)
+                 (eq? kind* 'major))
+             (apply set-info-version! (cons dir
+                                            (list (+ (car v) 1) 0 0))))
+            ((or (eq? kind* 'min)
+                 (eq? kind* 'minor))
+             (apply set-info-version! (cons dir
+                                            (list (car v) (+ (cadr v) 1) 0))))
+            (else
+             (apply set-info-version! (cons dir
+                                            (list (car v) (cadr v)
+                                                  (+ (caddr v) 1)))))
+            )
+          )
+        (error "kind must be 'maj, 'major, 'min, 'minor or 'patch")
+        )
+    )
+  )

private/utils.rkt

@@ -0,0 +1,49 @@
+#lang racket/base
+
+(require net/url)
+
+(provide input-prompt
+         valid-http-or-file-url?
+         )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+; goal   : Ask the user for input .
+; pre    : p is a prompt.
+; post   : It should give back the supplied input as string.
+; result : the return value of until.
+; internals:
+;
+; input-prompt displays the given prompt and reads a line
+; of text. After the user presses enter, this line is
+; fed to the until callback. If the until callback returns
+; #f, the prompt is displayed again. Otherwise, the value
+; of until is returned.
+;
+; The programmer must make sure the until returns whatever
+; format is appropriate. In general it will be a string. 
+;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (input-prompt p #:loop-until [until (λ (x) x)])
+  (let loop ()
+    (display p)
+    (flush-output)
+    (let ((inp (read-line)))
+      (let ((i (until inp)))
+        (if i
+            i
+            (loop)))
+      )
+    )
+  )
+
+
+(define (valid-http-or-file-url? value)
+  (if (not (string? value))
+      #f
+      (with-handlers ([exn:fail? (λ (exn) #f)])
+        (let ((url (string->url value)))
+          (and
+           (member (url-scheme url) '("http" "https" "file"))
+           (string? (url-host url))
+           (not (string=? (url-host url) "")))))))

scribblings/git-cli.scrbl

@@ -0,0 +1,760 @@
+#lang scribble/manual
+
+@(require (for-label racket/base
+                     racket/contract
+                     "../main.rkt"))
+
+@title[#:tag "top"]{git-cli}
+@author{Hans Dijkema}
+
+@defmodule[git-cli]
+
+The @racketmodname[git-cli] module provides a command-line-like Git interface
+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 Git @racket[command]. When the command has a registered git-cli wrapper,
+that wrapper is used. Registered wrappers can provide structured Racket results,
+argument handling, or other command-specific behavior.
+
+Registered command symbols include @racket['init], @racket['status],
+@racket['add], @racket['commit], @racket['push], @racket['pull],
+@racket['fetch], @racket['config], @racket['branch], @racket['remote],
+@racket['stash], @racket['restore], @racket['reset], @racket['revert],
+@racket['rebase], @racket['merge], @racket['cherry-pick],
+@racket['mergetool], @racket['switch], @racket['clone], @racket['tag],
+@racket['log], @racket['rev-list], @racket['diff], @racket['show],
+@racket['grep], @racket['help], @racket['version], and
+@racket['new-version].
+
+When no wrapper is registered, the command and arguments are passed directly to
+the installed Git executable through @racket[run-git]. The result is handled by
+the same standard result processing used by ordinary pass-through wrappers:
+normal Git output is displayed and a successful command returns @racket[#t];
+a non-zero exit status raises a git-cli error.
+
+This makes dedicated wrappers optional for Git commands where git-cli does not
+add useful behavior.
+
+@racketblock[
+(git 'blame "main.rkt")
+(git* clean -n)
+(git* worktree list)
+(git* archive --format=zip HEAD)
+]
+
+Some registered 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].
+}
+
+
+@defform[(git* command argument ...)]{
+Provides compact command-style syntax for @racket[git]. The command name is
+used as a symbol. Other literal arguments are converted to strings.
+
+@racketblock[
+(git* remote -v)
+(git* switch main)
+]
+
+An argument written as @racket[(eval expression)] is evaluated instead of being
+converted from its literal syntax.
+
+@racketblock[
+(define branch "develop")
+(git* switch (eval branch))
+]
+
+@bold{Important:} bare arguments to @racket[git*] are command-line text, not
+Racket values. An identifier is quoted syntactically and converted to a string,
+even when that identifier is also bound to a Racket variable or procedure.
+
+@racketblock[
+(define branch "develop")
+
+(git* switch branch)
+; passes "branch"
+
+(git* switch (eval branch))
+; passes "develop"
+]
+
+This distinction matters most for git-cli commands whose arguments are not
+ordinary Git command-line strings. Such wrappers should accept the textual
+arguments produced by @racket[git*]. For example, @racket[git-new-version] now
+accepts both symbols and text:
+
+@racketblock[
+(git 'new-version 'min)
+(git* new-version min)
+]
+
+Because @racket[git] falls back to direct Git execution for commands without a
+registered wrapper, @racket[git*] can also be used with those commands.
+
+@racket[gt] is retained as a compatibility alias for @racket[git*].
+}
+
+@section{Provided commands}
+
+@defproc[(git-init [argument any/c] ...) boolean?]{
+Runs @tt{git init} with the supplied arguments and returns @racket[#t] when Git
+exits successfully.
+
+@racketblock[
+(git-init)
+(git* init)
+(git* init --bare)
+]
+}
+
+@defproc[(git-status [argument any/c] ...) list?]{
+Runs @tt{git status --porcelain} with the supplied arguments.
+
+Each result item has the form
+@racket[(index-status worktree-status file)]. The index status describes the
+change staged for the next commit. The worktree status describes the change in
+the working tree relative to the index.
+
+Both statuses are one of @racket['unchanged], @racket['modified],
+@racket['type-changed], @racket['added], @racket['deleted], @racket['renamed],
+@racket['copied], @racket['unmerged], @racket['untracked], or
+@racket['ignored]. For an untracked file, Git reports @tt{??}, so both statuses
+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"))
+]}
+
+@defproc[(git-add [argument any/c] ...) boolean?]{
+Adds file contents to the index. Returns @racket[#t] when Git exits with status
+zero; otherwise an exception is raised.
+}
+
+@defproc[(git-commit [argument any/c] ...) boolean?]{
+Creates a commit. When @tt{-m} is omitted, a commit message is requested before
+Git is started. A repository with nothing to commit returns @racket[#t]. Other
+non-zero exit statuses, including a rejected commit hook, raise an exception.
+}
+
+@defproc[(git-push [argument any/c] ...) boolean?]{
+Pushes changes using @tt{--porcelain}. Returns @racket[#t] when Git exits with
+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 accepted when Git exits successfully.
+}
+
+@defproc[(git-fetch [argument any/c] ...) boolean?]{
+Downloads refs and objects from a remote repository without integrating them
+into the current branch. Arguments are passed directly to @tt{git fetch}.
+
+For example:
+
+@racketblock[
+(git-fetch)
+(git-fetch '--prune)
+(git 'fetch '--prune)
+]
+}
+
+@defproc[(git-config [argument any/c] ...) any/c]{
+Provides a Racket-oriented interface to @tt{git config}. The same interface is
+available through @racket[git] with command @racket['config].
+
+@racketblock[
+(git 'config '--all)
+(git 'config 'get '--all)
+(git 'config '--global 'get '--all)
+(git 'config 'get '--global '--all)
+]
+
+returns all visible configuration entries as key/value items:
+
+@racketblock[
+'(("user.name" "Hans Dijkema")
+  ("user.email" "hans@example.invalid")
+  ("credential.helper" "manager"))
+]
+
+@racketblock[
+(git 'config 'get "credential.helper")
+]
+
+returns one value as a string, or @racket[#f] when the key is absent.
+
+@racketblock[
+(git 'config 'get '--all "credential.helper")
+]
+
+returns all values for one key as a list. An absent key produces the empty
+list.
+
+Configuration values can be written with @racket['set!]:
+
+@racketblock[
+(git 'config 'set! "user.email" "hans@example.invalid")
+(git 'config '--global 'set! "user.email" "hans@example.invalid")
+(git 'config 'set! '--global "user.email" "hans@example.invalid")
+]
+
+The optional scope can be @tt{--global}, @tt{--local}, or @tt{--system}. It may
+appear directly after @racket['config] or directly after @racket['get] /
+@racket['set!]. A successful write returns @racket[#t].
+}
+
+@subsection{git-cli editor configuration}
+
+The @racket[git-config] procedure also recognizes the git-cli-specific
+@tt{editor} operation. This does not write Git's @tt{core.editor}; it controls
+the editor command used by git-cli through @tt{GIT_EDITOR} and
+@tt{GIT_SEQUENCE_EDITOR}.
+
+With no additional argument an interactive selection is displayed.
+
+@racketblock[
+(git* config editor)
+]
+
+The available editors can also be returned without prompting.
+
+@racketblock[
+(git* config editor --list)
+(git* config editor --downloads)
+]
+
+Each item contains the short editor name, description, command and a boolean
+indicating whether that command is currently selected.
+
+A detected editor can be selected by its short name, or automatic detection can
+be restored.
+
+@racketblock[
+(git* config editor vscode)
+(git* config editor notepad++)
+(git* config editor auto)
+]
+
+An arbitrary editor command can be supplied using the ordinary procedure form.
+
+@racketblock[
+(git 'config 'editor "C:\\Program Files\\MyEditor\\editor.exe --wait")
+]
+
+Changing the editor updates both @tt{GIT_EDITOR} and
+@tt{GIT_SEQUENCE_EDITOR} immediately for subsequent Git commands.
+
+@defproc[(find-editors) list?]{
+Returns all well-known GUI editors found on the current platform as
+@racket[(name description command)] items.
+}
+
+@defproc[(set-editor-auto!) string?]{
+Clears the explicit git-cli editor selection, activates the first automatically
+detected editor and returns its command. An exception is raised when no
+well-known GUI editor can be found.
+}
+
+@defproc[(editor-downloads) list?]{
+Returns official download pointers for optional GUI editors as
+@racket[(name description url)] items. No network request is performed.
+}
+
+On Windows, Notepad++ is detected both on @tt{PATH} and in the normal Program
+Files locations. git-cli invokes it with @tt{-multiInst -nosession}.
+
+@subsection{git-cli merge tool configuration}
+
+The @racket[git-config] procedure also recognizes the git-cli-specific
+@tt{mergetool} operation.
+
+@racketblock[
+(git* config mergetool)
+(git* config mergetool --list)
+(git* config mergetool --downloads)
+(git* config mergetool winmerge)
+(git* config mergetool auto)
+]
+
+With no additional argument an interactive selection is displayed.
+@tt{--list} returns @racket[(name description path current?)] items and
+@tt{--downloads} returns official download pointers. A detected merge tool can
+be selected by its short Git tool name. @tt{auto} clears the explicit git-cli
+selection and restores automatic detection.
+
+@defproc[(find-mergetools) list?]{
+Returns all well-known graphical merge tools found on the current platform as
+@racket[(name description path)] items.
+}
+
+@defproc[(mergetool-downloads) list?]{
+Returns official download pointers for optional merge tools as
+@racket[(name description url)] items. No network request is performed.
+}
+
+@defproc[(set-mergetool-auto!) string?]{
+Clears the explicit git-cli merge tool selection and returns the first
+automatically detected Git merge tool name. An exception is raised when no
+well-known merge tool can be found.
+}
+
+@defproc[(git-branch [argument any/c] ...) (or/c boolean? list?)]{
+Runs @tt{git branch} with the supplied arguments. This can be used to list,
+create, rename, or delete branches according to the options supported by the
+installed Git executable.
+
+With Git's @tt{-l} or @tt{--list} option, git-cli returns structured branch
+information. Each item starts with one of @racket['current], @racket['local],
+or @racket['remote], followed by the branch name.
+
+@racketblock[
+(git-branch '-l)
+
+'((current "main")
+  (local "develop"))
+]
+
+Git's normal branch selection and sorting options are passed through. For
+example, remote branches can be requested with @tt{-r}, all branches with
+@tt{-a}, and Git's @tt{--sort=<key>} option controls the returned order.
+
+@racketblock[
+(git 'branch '-l '-a "--sort=refname")
+
+'((current "main")
+  (local "develop")
+  (remote "origin/main"))
+]
+
+Without @tt{-l} or @tt{--list}, normal Git output is displayed and the
+procedure returns @racket[#t] when Git exits successfully.
+}
+@defproc[(git-remote [argument any/c] ...) any/c]{
+Runs @tt{git remote} with the supplied arguments and keeps the command's own
+subcommand structure.
+
+With no arguments, the remote names are returned as a Racket list.
+
+@racketblock[
+(git-remote)
+
+'("origin" "upstream")
+]
+
+With top-level @tt{-v} or @tt{--verbose}, each line reported by Git is returned
+as a separate structured item containing the remote name, URL, and the
+@racket['fetch] or @racket['push] role.
+
+@racketblock[
+(git-remote '-v)
+
+'(("origin" "https://example.invalid/project.git" fetch)
+  ("origin" "https://example.invalid/project.git" push))
+]
+
+The two Git lines are deliberately not merged. This keeps the result close to
+the output and semantics of @tt{git remote -v}.
+
+For @tt{get-url}, one URL is returned as a string. With @tt{--all}, a list of
+URLs is returned.
+
+@racketblock[
+(git 'remote 'get-url "origin")
+(git 'remote 'get-url '--all "origin")
+(git 'remote 'get-url '--push '--all "origin")
+]
+
+Other forms, including @tt{add}, @tt{rename}, @tt{remove}, @tt{set-head},
+@tt{show}, @tt{prune}, @tt{update}, @tt{set-branches}, and @tt{set-url}, are
+passed to Git unchanged and use the normal git-cli command result processing.
+}
+@defproc[(git-stash [argument any/c] ...) (or/c boolean? list?)]{
+Runs @tt{git stash} with the supplied arguments. Calling it without a
+subcommand keeps Git's normal behavior, which is equivalent to
+@tt{git stash push}.
+
+@tt{git stash list} is returned as structured Racket data. Each item contains
+the stash reference and Git's stash description.
+
+@racketblock[
+(git-stash 'list)
+
+'(("stash@{0}" "WIP on main: 1234567 Example")
+  ("stash@{1}" "On main: older work"))
+]
+
+The structured form is only used when the caller has not supplied a
+@tt{--format} or @tt{--pretty} option. Explicit Git formatting is left
+unchanged.
+
+Other stash subcommands, including @tt{push}, @tt{show}, @tt{pop},
+@tt{apply}, @tt{drop}, @tt{clear}, @tt{branch}, @tt{create}, @tt{store},
+@tt{export}, and @tt{import}, are passed to Git unchanged.
+}
+
+@defproc[(git-restore [argument any/c] ...) boolean?]{
+Runs @tt{git restore} with the supplied arguments. Git's path, source,
+@tt{--staged}, @tt{--worktree}, and patch semantics are preserved.
+
+@racketblock[
+(git-restore "main.rkt")
+(git-restore '--staged "main.rkt")
+(git* restore --source=HEAD~1 main.rkt)
+]
+}
+
+@defproc[(git-reset [argument any/c] ...) boolean?]{
+Runs @tt{git reset} with the supplied arguments. Modes such as @tt{--soft},
+@tt{--mixed}, @tt{--hard}, @tt{--merge}, and @tt{--keep}, as well as path
+forms, are passed through unchanged.
+
+@racketblock[
+(git-reset '--hard 'HEAD)
+(git* reset --soft HEAD~1)
+]
+}
+
+@defproc[(git-revert [argument any/c] ...) boolean?]{
+Runs @tt{git revert} with the supplied arguments. Sequencer controls such as
+@tt{--continue}, @tt{--skip}, @tt{--quit}, and @tt{--abort} are passed through
+unchanged.
+
+@racketblock[
+(git-revert 'HEAD)
+(git* revert --abort)
+]
+}
+
+@defproc[(git-rebase [argument any/c] ...) boolean?]{
+Runs @tt{git rebase} with the supplied arguments, including normal, interactive,
+and continuation/abort forms.
+
+@racketblock[
+(git-rebase "main")
+(git* rebase --continue)
+(git* rebase --abort)
+]
+}
+
+@defproc[(git-merge [argument any/c] ...) boolean?]{
+Runs @tt{git merge} with the supplied arguments and preserves Git's merge
+options and control forms.
+
+@racketblock[
+(git-merge "feature")
+(git* merge --abort)
+]
+}
+
+@defproc[(git-cherry-pick [argument any/c] ...) boolean?]{
+Runs @tt{git cherry-pick} with the supplied arguments. Sequencer controls such
+as @tt{--continue}, @tt{--skip}, @tt{--quit}, and @tt{--abort} are passed
+through unchanged.
+
+@racketblock[
+(git-cherry-pick "abc1234")
+(git* cherry-pick --continue)
+]
+}
+
+@defproc[(git-mergetool [argument any/c] ...) boolean?]{
+Runs @tt{git mergetool}. When the caller does not specify @tt{-t},
+@tt{--tool=<tool>}, or @tt{--tool-help}, git-cli first tries
+@racket[find-mergetool] and supplies the selected tool through Git's normal
+@tt{--tool=<tool>} option. If no known graphical tool is found, Git is allowed
+to choose its own default.
+
+@racketblock[
+(git-mergetool)
+(git* mergetool --tool=meld)
+]
+}
+
+@defproc[(find-editor) (or/c string? #f)]{
+Returns the configured or detected GUI editor command. When git-cli is
+loaded, the detected editor is assigned once to @tt{GIT_EDITOR} and
+@tt{GIT_SEQUENCE_EDITOR}. The editor is not started by this procedure.
+}
+
+@defproc[(set-editor! [command string?]) any/c]{
+Stores a git-cli-specific editor command.
+}
+
+@defproc[(find-mergetool) (or/c string? #f)]{
+Returns the configured or detected Git merge tool name.
+}
+
+@defproc[(find-mergetool-path) (or/c path? #f)]{
+Returns the executable path of an automatically detected merge tool. The finder
+checks @tt{PATH} first and then well-known platform installation locations.
+When the merge tool was configured explicitly by name, this procedure returns
+@racket[#f].
+}
+
+@defproc[(set-mergetool! [tool string?]) any/c]{
+Stores the Git merge tool name preferred by git-cli.
+}
+
+@defproc[(git-switch [argument any/c] ...) boolean?]{
+Runs @tt{git switch} with the supplied arguments.
+
+@racketblock[
+(git-switch "main")
+(git-switch '-c "feature")
+(git 'switch "main")
+]
+}
+
+@defproc[(git-clone [argument any/c] ...) boolean?]{
+Runs @tt{git clone} with the supplied arguments.
+}
+
+@defproc[(git-tag [argument any/c] ...) (or/c boolean? list?)]{
+Runs @tt{git tag} with the supplied arguments. It can list, create, delete, or
+verify tags according to the options supported by Git.
+
+When @tt{-l} or @tt{--list} is supplied, the matching tag names are returned
+as a Racket list. Git's sorting options are passed through unchanged, so the
+returned list keeps Git's order.
+
+@racketblock[
+(git-tag '-l)
+(git-tag '--list "--sort=version:refname")
+(git-tag '--list "--sort=-creatordate")
+]
+
+When @tt{-n} or @tt{-n1} is combined with @tt{-l} or @tt{--list}, each result
+item contains the tag name and the subject reported by Git.
+
+@racketblock[
+(git-tag '-l '-n)
+
+'(("v0.3.16" "Release 0.3.16")
+  ("v0.3.17" "Release 0.3.17"))
+]
+
+With @tt{-n<number>} and a number greater than one, git-cli asks Git for that
+many content lines using @tt{%(contents:lines=<number>)}. The returned message
+is kept as one string, including embedded newlines.
+
+For structured tag output git-cli asks Git for an explicit format using
+@tt{%(refname:strip=2)} and either @tt{%(contents:subject)} or
+@tt{%(contents:lines=<number>)}. Generated field and record delimiters are used
+to split the result safely.
+
+Other forms keep the normal command behavior and return @racket[#t] when Git
+exits successfully. Git errors are handled by the standard git-cli result
+processor.
+}
+@defproc[(git-rev-list [argument any/c] ...) boolean?]{
+Runs @tt{git rev-list} with the supplied arguments and displays Git's normal
+output. It returns @racket[#t] when Git exits successfully.
+}
+
+@defproc[(git-diff [argument any/c] ...) (or/c boolean? string?)]{
+Shows differences between Git objects or the working tree and index.
+
+By default a successful diff is rendered as HTML in the default browser. The
+git-cli-specific option @tt{--output=-} keeps Git's textual output on standard
+output. @tt{--output=string} returns the textual diff as a string.
+
+@racketblock[
+(git-diff)
+(git-diff '--cached)
+(git-diff '--output=-)
+(git-diff '--output=string)
+]
+}
+
+@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-show [argument any/c] ...) (or/c boolean? string? list?)]{
+Shows a Git object.
+
+For a commit that includes a patch, the default git-cli output is HTML. The
+commit information is shown above the diff and the diff is rendered using the
+same Diff2Html presentation as @racket[git-diff].
+
+The git-cli-specific output options are @tt{--output=html},
+@tt{--output=-}, and @tt{--output=string}. @tt{--output=html} explicitly
+selects the HTML presentation, @tt{--output=-} keeps Git's normal textual
+output, and @tt{--output=string} returns that textual output as a string.
+Options such as @tt{--stat}, @tt{--name-only}, @tt{--name-status}, and
+@tt{--no-patch} default to textual output because they do not normally contain
+a patch.
+
+The git-cli-specific option @tt{--list}, or its short form @tt{-l}, returns a
+Racket value. Without another show-format option it implies @tt{--stat}.
+
+@racketblock[
+(git-show '-l "9741b1c")
+]
+
+The result of @tt{--stat --list} contains @racket['file] and
+@racket['total] items:
+
+@racketblock[
+'((file "README.md" 67 "+++---")
+  (file "main.rkt" 532 "++++-------------------------------------------")
+  (total 9 124 823))
+]
+
+With @tt{--name-only --list}, the result is a list of file names. With
+@tt{--name-status --list}, every result item is the tab-separated Git
+name-status record converted to a list of strings.
+
+@tt{--list}/@tt{-l} cannot be combined with @tt{--output=...}. Only one of
+@tt{--stat}, @tt{--name-only}, and @tt{--name-status} can be used with
+@tt{--list}.
+}
+
+@defproc[(git-grep [argument any/c] ...) list?]{
+Searches tracked files. Each result contains the file, optional line number,
+optional match count, and matched text. Exit status one means that no matches
+were found and returns an empty list.
+}
+
+@defproc[(git-help [argument any/c] ...) boolean?]{
+Runs @tt{git help} with the supplied arguments and returns @racket[#t] when Git
+exits successfully.
+}
+
+@section{Package version}
+
+@defproc[(git-version) list?]{
+Reads the package version from @filepath{info.rkt} and returns it as a list
+containing major, minor, and patch.
+}
+
+
+@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
+abbreviations. The result is the new version as a list of three integers.
+}
+
+@racketblock[
+(git-new-version 'min)
+(git 'new-version 'min)
+(git* new-version min)
+]
+
+The version kind may be supplied as a symbol or string. This makes the command
+compatible with @racket[git*], whose bare arguments are converted to text.
+
+
+
+@section{Low-level Git execution}
+
+@defproc[(run-git [args list?]
+                  [#:input input (or/c #f string?) #f])
+         (values exact-integer? list?)]{
+Runs Git without interactive terminal prompts. When @racket[input] is a string,
+it is written to Git's standard input before that input port is closed.
+
+The procedure returns two values: Git's exit code and the ordered output items,
+where each item identifies either @racket['stdout] or @racket['stderr].
+
+@racketblock[
+(run-git '(credential fill)
+         #:input "protocol=https\nhost=git.dijkewijk.nl\n\n")
+]
+}
+
+@section{Authentication retry}
+
+Git commands recognize common authentication failures immediately after the
+Git process finishes and before command-specific result processing takes
+place. Such a failure is represented by @racket[exn:fail:git-auth?].
+
+@defparam[current-git-authentication-handler handler procedure?]{
+Controls the callback used when an authentication failure is detected. The
+callback receives the Git command symbol, the processed Git argument list and
+the @racket[exn:fail:git-auth] exception.
+
+The callback returns a true value when it has handled authentication and the
+original Git command should be tried again. A command is retried at most once.
+The default callback is @racket[default-git-authentication-handler].
+
+@racketblock[
+(current-git-authentication-handler
+ (lambda (cmd args e)
+   ;; Perform credential handling here.
+   #t))
+]
+}
+
+@defproc[(exn:fail:git-auth? [v any/c]) boolean?]{
+Recognizes the authentication exception used internally by git-cli.
+}
+
+@defproc[(exn:fail:git-auth-command [e exn:fail:git-auth?]) symbol?]{
+Returns the Git command of the failed invocation.
+}
+
+@defproc[(exn:fail:git-auth-args [e exn:fail:git-auth?]) list?]{
+Returns the processed Git arguments of the failed invocation.
+}
+
+@defproc[(exn:fail:git-auth-exit-code [e exn:fail:git-auth?]) exact-integer?]{
+Returns Git's exit code.
+}
+
+@defproc[(exn:fail:git-auth-output [e exn:fail:git-auth?]) list?]{
+Returns the ordered @racket['stdout]/@racket['stderr] output items from the
+failed Git process.
+}
+
+
+
+@section{Authentication}
+
+@defproc[(default-git-authentication-handler
+          [cmd symbol?]
+          [args list?]
+          [e exn:fail:git-auth?])
+         boolean?]{
+Handles one authentication failure. A credential that already failed is first
+rejected. An existing Git credential helper is then asked for a replacement
+credential. If that does not succeed, git-cli requests a username and
+password/token using @racket[input-prompt]. Its @racket[#:loop-until] callbacks
+both validate the input and return the value that is used. If no helper is
+configured, Git's non-persistent @tt{cache} helper is configured locally before
+the credential is approved. The original command is retried once; a credential
+that fails on the retry is rejected before the Git error is raised.
+}
+
+@defparam[current-git-authentication-handler handler procedure?]{
+Contains the authentication callback used after a recognized authentication
+failure. Its default value is @racket[default-git-authentication-handler].
+}

scribblings/git.scrbl

@@ -1,179 +0,0 @@
-#lang scribble/manual
-
-@(require (for-label racket/base git))
-
-@title{git}
-@author{Hans Dijkema}
-
-@defmodule[git]
-
-The @racketmodname[git] module provides a small command-line-like Git interface implemented on top of the @tt{libgit2} package. It does not invoke the @tt{git} executable.
-
-The short form is intended for build scripts and interactive use:
-
-@racketblock[
-(require git)
-
-(git 'status)
-(git 'diff)
-(git 'diff '--cached)
-(git 'add "main.rkt" "info.rkt")
-(git 'commit "Implement raco support")
-(git 'tag "v0.1")
-(git 'checkout "main")
-]
-
-@defproc[(git [command symbol?] [#:quiet quiet any/c #f] [argument any/c] ...) any/c]{
-Dispatches @racket[command] to the corresponding Git procedure. For example, @racket[(git 'status)] calls @racket[git-status], and @racket[(git 'commit "message")] calls @racket[git-commit]. Command names are ordinary symbols, so @racket[git] can safely be used inside other macros and DSLs. For network commands, @racket[#:quiet] suppresses progress output.
-}
-
-@defproc[(dgit [command symbol?] [#:quiet quiet any/c #f] [argument any/c] ...) any/c]{
-Calls @racket[git], displays its result in a compact human-readable form, and returns the original result. Status entries are displayed with labels such as @tt{Modified}, @tt{New}, @tt{Deleted}, and @tt{Renamed}. Ignored files remain omitted, just as with @racket[git-status].
-}
-
-@racketblock[
-(dgit 'status)
-]
-
-@section{Repository}
-
-@defproc[(git-repository? [path path-string? (current-directory)]) boolean?]{Returns whether @racket[path] is inside a Git repository.}
-
-@defproc[(git-root [path path-string? (current-directory)]) path?]{Returns the repository worktree root.}
-
-@defproc[(git-init [path path-string? (current-directory)] [#:bare? bare? any/c #f]) path?]{Initializes a repository.}
-
-@defproc*[([(git-clone [url string?] [#:quiet quiet any/c #f]) path?]
-           [(git-clone [url string?] [path path-string?] [#:quiet quiet any/c #f]) path?])]{Clones @racket[url]. If @racket[path] is omitted, a directory name is derived from the URL. Progress is written to the current output port unless @racket[quiet] is true.}
-
-@section{Status and index}
-
-@defstruct*[git-status-entry ([path string?] [code string?] [flags list?])]{Describes one status entry. The @racket[code] field uses the familiar two-character Git status notation.}
-
-@defproc[(git-status) (listof git-status-entry?)]{Returns worktree and index status.}
-
-@defproc[(git-status-lines [entries (listof git-status-entry?) (git-status)]) (listof string?)]{Formats status entries as short Git-like lines.}
-
-@defproc[(git-clean?) boolean?]{Returns @racket[#t] when @racket[git-status] is empty.}
-
-@defproc*[([(git-diff) string?]
-           [(git-diff [option (or/c '--cached)]) string?])]{Returns a unified patch as a string. With no arguments it compares the index with the worktree, like @tt{git diff}. With @racket['--cached] it compares HEAD with the index, like @tt{git diff --cached}.}
-
-
-@defproc[(git-add [path path-string?] ...) void?]{Stages the given paths. With no paths, stages the whole repository, including tracked removals.}
-
-@section{Configuration and commits}
-
-@defproc*[([(git-config [key string?]) string?]
-           [(git-config [key string?] [value string?]) string?])]{Reads or writes a repository configuration value. The two-argument form returns @racket[value].}
-
-@defproc[(git-head) (or/c string? #f)]{Returns the full OID of HEAD, or @racket[#f] for a repository without commits.}
-
-@defproc[(git-commit [message string?]) string?]{Creates a commit from the index and returns its full OID. The author and committer are read from the repository configuration.}
-
-@section{Branches, checkout, and tags}
-
-@defproc[(git-current-branch) (or/c string? #f)]{Returns the current local branch name, or @racket[#f] for detached HEAD.}
-
-@defproc*[([(git-branch) (listof string?)]
-           [(git-branch [name string?]) string?])]{Lists local branches, or creates @racket[name] at HEAD.}
-
-@defproc[(git-branch-delete [name string?]) void?]{Deletes a local branch.}
-
-@defproc[(git-checkout [name string?]) (or/c string? #f)]{Checks out a local branch, tag, or commit. A tag or commit produces detached HEAD.}
-
-@defproc[(git-checkout-new [name string?]) string?]{Creates and checks out a new branch.}
-
-@defproc*[([(git-tag) (listof string?)]
-           [(git-tag [name string?]) string?])]{Lists tags, or creates a lightweight tag at HEAD and returns its OID.}
-
-@defproc[(git-tag-delete [name string?]) void?]{Deletes a tag.}
-
-@section{Log}
-
-@defstruct*[git-log-entry ([id string?] [summary string?] [time integer?])]{Describes one commit returned by @racket[git-log].}
-
-@defproc[(git-log [max-count exact-nonnegative-integer? 20]) (listof git-log-entry?)]{Returns commits from HEAD in topological/time order.}
-
-@defproc[(git-log-lines [entries (listof git-log-entry?) (git-log)]) (listof string?)]{Formats log entries as short OID plus summary.}
-
-@section{Remotes}
-
-@defproc[(git-remotes) (listof string?)]{Lists remotes.}
-
-@defproc[(git-remote-add [name string?] [url string?]) string?]{Adds a remote.}
-
-@defproc[(git-remote-url [name string? "origin"]) string?]{Returns the remote URL.}
-
-@defproc[(git-fetch [remote string? "origin"] [#:quiet quiet any/c #f]) void?]{Fetches the configured refspecs from a remote. Progress is written to the current output port unless @racket[quiet] is true.}
-
-@defproc[(git-pull [remote string? "origin"] [#:quiet quiet any/c #f]) (or/c string? #f)]{Fetches and performs a fast-forward-only update of the current branch. Returns the new OID, or @racket[#f] when already up to date. A non-fast-forward update raises an exception.}
-
-@defproc[(git-push [remote string? "origin"] [branch (or/c string? #f) #f] [#:quiet quiet any/c #f]) void?]{Pushes a branch to a branch with the same name. With no positional arguments, the current branch is pushed to @tt{origin}; with only @racket[remote], the current branch is pushed there. Progress is written to the current output port unless @racket[quiet] is true.}
-
-@defproc[(git-push-tag [tag string?] [remote string? "origin"] [#:quiet quiet any/c #f]) void?]{Pushes one tag. Progress is written to the current output port unless @racket[quiet] is true.}
-
-Remote HTTPS operations automatically use credentials from the @tt{racket-git} credential store when an entry exists for the remote host.
-
-@section{Command form}
-
-The following command-like forms are supported directly:
-
-@racketblock[
-(git 'init)
-(git 'clone "https://example/repo.git")
-(git 'status)
-(git 'add "file.rkt")
-(git 'config "user.name" "Name")
-(git 'commit "message")
-(git 'branch)
-(git 'branch "feature")
-(git 'branch '-d "feature")
-(git 'checkout "main")
-(git 'checkout '-b "feature")
-(git 'tag)
-(git 'tag "v0.1")
-(git 'tag '-d "v0.1")
-(git 'log 10)
-(git 'remote)
-(git 'remote 'add "origin" "https://example/repo.git")
-(git 'remote 'get-url "origin")
-(git 'fetch)
-(git 'pull)
-(git 'push)
-(git 'push #:quiet #t)
-(git 'push-tag "v0.1")
-]
-
-@section{HTTPS credentials}
-
-Git credentials are stored in @tt{racket-git.ini} in the normal Racket
-preferences directory. Tokens are encrypted with AES-GCM. The encryption key is
-derived from the store password with PBKDF2-HMAC-SHA256.
-
-@defproc[(git-credentials-init! [password string?]
-                                [#:unlock-for seconds real? 86400]) void?]{
-Creates the credential store and leaves it unlocked for @racket[seconds].}
-
-@defproc[(git-credentials-unlock! [password string?]
-                                  [#:for seconds real? 86400]) void?]{
-Unlocks the credential store. The temporary unlock state is stored separately in
-@tt{racket-git-unlock.ini}, allowing the unlock to survive restarting DrRacket
-or starting another Racket process. Both credential INI files use
-@racket[#:private? #t] storage from @racketmodname[simple-ini], which restricts
-them to mode 0600 on Unix.}
-
-@defproc[(git-credentials-lock!) void?]{Locks the credential store immediately.}
-
-@defproc[(git-credentials-unlocked?) boolean?]{Returns whether a non-expired
-unlock key is currently available.}
-
-@defproc[(git-credentials-set! [remote string?] [username string?] [token string?]) void?]{
-Stores an HTTPS username and token. Credentials are keyed by host.}
-
-@defproc[(git-credentials-ref [remote string?]) (or/c #f pair?)]{
-Returns the username/token pair for @racket[remote], or @racket[#f] when none is
-stored. The store must be unlocked when a credential exists.}
-
-@defproc[(git-credentials-remove! [remote string?]) void?]{Removes credentials
-for the host represented by @racket[remote].}

scribblings/manual-racket.css

@@ -1,326 +0,0 @@
-/* See the beginning of "manual.css". */
-
-/* Monospace: */
-
-.RktIn, .RktRdr, .RktPn, .RktMeta,
-.RktMod, .RktKw, .RktVar, .RktSym,
-.RktRes, .RktOut, .RktCmt, .RktVal,
-.RktBlk, .RktErr {
-  font-family: 'Fira-Mono', monospace;
-  white-space: inherit;
-  font-size: 1rem;
-  line-height: 1.5;
-
-}
-
-/* this selctor grabs the first linked Racket symbol
-in a definition box (i.e., the symbol being defined) */
-a.RktValDef, a.RktStxDef, a.RktSymDef,
-span.RktValDef, span.RktStxDef, span.RktSymDef
-{
-    font-size: 1.1rem;
-    color: black;
-    font-weight: 500;
-}
-
-
-.inheritedlbl {
-  font-family: 'Fira', sans-serif;
-}
-
-.RBackgroundLabelInner {
-  font-family: inherit;
-}
-
-/* ---------------------------------------- */
-/* Inherited methods, left margin */
-
-.inherited {
-  width: 95%;
-  margin-top: 0.5em;
-  text-align: left;
-  background-color: inherit;
-}
-
-.inherited td {
-  font-size: 82%;
-  padding-left: 0.5rem;
-  line-height: 1.3;
-  text-indent: 0;
-  padding-right: 0;
-}
-
-.inheritedlbl {
-  font-style: normal;
-}
-
-/* ---------------------------------------- */
-/* Racket text styles */
-
-.RktIn {
-  color: #cc6633;
-  background-color: #eee;
-  white-space: pre;
-}
-
-.RktInBG {
-  background-color: #eee;
-}
-
-
-.refcolumn .RktInBG {
-  background-color: white;
-}
-
-.RktRdr {
-}
-
-.RktPn {
-  color: #843c24;
-}
-
-.RktMeta {
-  color: black;
-}
-
-.RktMod {
-  color: inherit;
-}
-
-.RktOpt {
-  color: black;
-  font-style: italic;
-}
-
-.RktKw {
-  color: black;
-}
-
-.RktErr {
-  color: red;
-  font-style: italic;
-  font-weight: 400;
-}
-
-.RktVar {
-    position: relative;
-    left: -1px; font-style: italic;
-    color: #444;
-}
-
-.SVInsetFlow .RktVar {
-    font-weight: 400;
-    color: #444;
-}
-
-
-.RktSym {
-   color: inherit;
-}
-
-
-
-.RktValLink, .RktStxLink, .RktModLink {
-  text-decoration: none;
-    color: #07A;
-    font-size: 1rem;
-}
-
-/* for syntax links within headings */
-h1 a.RktStxLink, h2 a.RktStxLink, h3 a.RktStxLink, h4 a.RktStxLink, h5 a.RktStxLink,
-h1 a.RktValLink, h2 a.RktValLink, h3 a.RktValLink, h4 a.RktValLink, h5 a.RktValLink,
-h1 .RktSym, h2 .RktSym, h3 .RktSym, h4 .RktSym, h5 .RktSym,
-h1 .RktMod, h2 .RktMod, h3 .RktMod, h4 .RktMod, h5 .RktMod,
-h1 .RktVal, h2 .RktVal, h3 .RktVal, h4 .RktVal, h5 .RktVal,
-h1 .RktPn, h2 .RktPn, h3 .RktPn, h4 .RktPn, h5 .RktPn {
-    color: #333;
-    font-size: 1.50rem;
-    font-weight: 400;
-}
-
-.toptoclink .RktStxLink, .toclink .RktStxLink,
-.toptoclink .RktValLink, .toclink .RktValLink,
-.toptoclink .RktModLink, .toclink .RktModLink {
-    color: inherit;
-}
-
-.tocset .RktValLink, .tocset .RktStxLink, .tocset .RktModLink, .tocset .RktSym {
-    color: black;
-    font-weight: 400;
-    font-size: 0.9rem;
-}
-
-.tocset td a.tocviewselflink .RktValLink,
-.tocset td a.tocviewselflink .RktStxLink,
-.tocset td a.tocviewselflink .RktMod,
-.tocset td a.tocviewselflink .RktSym {
-    font-weight: lighter;
-    color: white;
-}
-
-
-.RktRes {
-  color: #0000af;
-}
-
-.RktOut {
-  color: #960096;
-}
-
-.RktCmt {
-  color: #c2741f;
-}
-
-.RktVal {
-  color: #228b22;
-}
-
-/* ---------------------------------------- */
-/* Some inline styles */
-
-.together { /* for definitions grouped together in one box */
-  width: 100%;
-  border-top: 2px solid white;
-}
-
-tbody > tr:first-child > td > .together {
-  border-top: 0px; /* erase border on first instance of together */
-}
-
-.RktBlk {
-  white-space: pre;
-  text-align: left;
-}
-
-.highlighted {
-    font-size: 1rem;
-    background-color: #fee;
-}
-
-.defmodule {
-    font-family: 'Fira-Mono', monospace;
-    padding: 0.25rem 0.75rem 0.25rem 0.5rem;
-    margin-bottom: 1rem;
-    width: 100%;
-    background-color: #ebf0f4;
-}
-
-.defmodule a {
-    color: #444;
-}
-
-
-.defmodule td span.hspace:first-child {
-  position: absolute;
-  width: 0;
-  display: inline-block;
-}
-
-.defmodule .RpackageSpec .Smaller,
-.defmodule .RpackageSpec .stt {
-    font-size: 1rem;
-}
-
-/* make parens ordinary color in defmodule */
-.defmodule .RktPn {
-    color: inherit;
-}
-
-.specgrammar {
-    float: none;
-    padding-left: 1em;
-}
-
-
-.RBibliography td {
-  vertical-align: text-top;
-  padding-top: 1em;
-}
-
-.leftindent {
- margin-left: 2rem;
- margin-right: 0em;
-}
-
-.insetpara {
- margin-left: 1em;
- margin-right: 1em;
-}
-
-.SCodeFlow .Rfilebox {
-    margin-left: -1em; /* see 17.2 of guide, module languages */
-}
-
-.Rfiletitle {
-  text-align: right;
-  background-color: #eee;
-}
-
-.SCodeFlow .Rfiletitle {
-  border-top: 1px dotted gray;
-  border-right: 1px dotted gray;
-}
-
-
-.Rfilename {
-  border-top: 0;
-  border-right: 0;
-  padding-left: 0.5em;
-  padding-right: 0.5em;
-  background-color: inherit;
-}
-
-.Rfilecontent {
-  margin: 0.5em;
-}
-
-.RpackageSpec {
-  padding-right: 0;
-}
-
-/* ---------------------------------------- */
-/* For background labels */
-
-.RBackgroundLabel {
-   float: right;
-   width: 0px;
-   height: 0px;
-}
-
-.RBackgroundLabelInner {
-   position: relative;
-   width: 25em;
-   left: -25.5em;
-   top: 0.20rem; /* sensitive to monospaced font choice */
-   text-align: right;
-   z-index: 0;
-   font-weight: 300;
-   font-family: 'Fira-Mono', monospace;
-   font-size: 0.9rem;
-    color: gray;
-}
-
-
-.RpackageSpec .Smaller {
-   font-weight: 300;
-   font-family: 'Fira-Mono', monospace;
-   font-size: 0.9rem;
-}
-
-.RForeground {
-   position: relative;
-   left: 0px;
-   top: 0px;
-   z-index: 1;
-}
-
-/* ---------------------------------------- */
-/* For section source modules & tags */
-
-.RPartExplain {
-    background: #eee;
-    font-size: 0.9rem;
-    margin-top: 0.2rem;
-    padding: 0.2rem;
-    text-align: left;
-}

scribblings/manual-racket.js

@@ -1,268 +0,0 @@
-/* For the Racket manual style */
-
-AddOnLoad(function() {
-    /* Look for header elements that have x-source-module and x-part tag.
-       For those elements, add a hidden element that explains how to
-       link to the section, and set the element's onclick() to display
-       the explanation. */
-    var tag_names = ["h1", "h2", "h3", "h4", "h5"];
-    for (var j = 0; j < tag_names.length; j++) {
-        elems = document.getElementsByTagName(tag_names[j]);
-        for (var i = 0; i < elems.length; i++) {
-            var elem = elems.item(i);
-            AddPartTitleOnClick(elem);
-        }
-    }
-})
-
-// for copies that start in Racket code, strip out extra newlines
-AddOnLoad(function() {
-  const codeBlocks = document.getElementsByClassName("SCodeFlow");
-  for (var i = 0; i < codeBlocks.length; i++) {
-    var codeBlock = codeBlocks[i];
-    console.log("add");
-    codeBlock.addEventListener('copy', function(e) {
-      var selection = window.getSelection();
-      var text = selection.toString();
-      var codeText = text.replace(/\n\n/g, '\n');
-      if (text != codeText) {
-        e.preventDefault();
-        e.clipboardData.setData('text/plain', codeText);
-      }
-    })
-  }
-})
-
-// cache of source urls
-var cache = {};
-
-function ParseSource(source, mod_path, single_collection) {
-
-    var source_url = new URL(source);
-
-    if (source_url.protocol == "github:") {
-        // browser URL parser only works with http(s) URLs
-        source_url = new URL("https" + source.substring(6));
-        var host = source_url.host;
-        var url_path = source_url.pathname.substring(1).split("/");
-        if (!(url_path.length >= 2)) return null;
-        var user = url_path.shift();
-        var repo = url_path.shift();
-        var branch = url_path.shift();
-        var source_path = url_path.join("/");
-    }
-    else if (("https:" == source_url.protocol) || ("git:" == source_url.protocol)) {
-        // browser URL parser only works with http(s) URLs
-        if ("git:" == source_url.protocol)
-            source_url = new URL("https" + source.substring(3));
-
-        var host = source_url.host;
-        var source_path = source_url.searchParams.get("path");
-        var branch = (source_url.hash || "#master").substring(1);
-        var url_path = source_url.pathname.substring(1).split("/");
-        if (url_path.length < 2) throw [source_url.pathname, url_path];
-        var user = url_path.shift();
-        var repo = url_path.shift();
-        var mtch = repo.match(/(.*)\.git$/);
-        if (mtch) repo = mtch[1];
-
-    }
-    else return null;
-
-    var mod_path_re = /^\(lib "(.+)"\)$/;
-
-    var mod_path_elems = mod_path && mod_path.match(mod_path_re)[1].split("/");
-
-    if (!user || !repo || !mod_path_elems)
-        return null;
-    if (single_collection)
-        mod_path_elems.shift();
-
-    var file_path = mod_path_elems.join("/");
-
-
-    if (source_path) {
-        file_path = source_path + "/" + file_path;
-    }
-
-    return { user: user,
-             repo: repo,
-             file_path: file_path,
-             branch: branch,
-             host: host };
-}
-
-function AddSourceElement(pkg_url, info) {
-    info.appendChild(document.createTextNode("Document source "));
-    var url_line = document.createElement("div");
-    var a = document.createElement("a");
-    a.href = pkg_url;
-    a.style.whiteSpace = "nowrap";
-    a.appendChild(document.createTextNode(pkg_url));
-    addSpan(url_line, "\xA0", "RktRdr");
-    url_line.appendChild(a);
-    info.appendChild(url_line);
-}
-
-var prefixes = { "github.com": "tree",
-                 "gitlab.com": "-/blob" };
-
-
-function AddSourceUrl(source, mod_path, collection, info) {
-    // multi is encoded as an array, empty as false
-    single_collection = (typeof collection === "string");
-
-    var parsed = source && mod_path && ParseSource(source, mod_path, single_collection);
-
-    if (!parsed) return;
-
-    prefix = prefixes.hasOwnProperty(parsed.host) && prefixes[parsed.host];
-    if (!prefix) return;
-
-    var correct_url = "https://" + [parsed.host, parsed.user, parsed.repo, prefix, parsed.branch, parsed.file_path].join("/");
-
-    if (info) AddSourceElement(correct_url, info);
-}
-
-function addSpan(dest, str, cn) {
-    var s = document.createElement("span");
-    s.className = cn;
-    s.style.whiteSpace = "nowrap";
-    s.appendChild(document.createTextNode(str));
-    dest.appendChild(s);
-}
-
-
-// test cases
-if (false) {
-    console.log(ParseSource("git://gitlab.com/benn/foo?path=xxx",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            false))
-    console.log(ParseSource("github://github.com/carl-eastlund/mischief/master",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            false))
-    console.log(ParseSource("github://github.com/carl-eastlund/mischief/stable/dir",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            false))
-
-    console.log(ParseSource("git://github.com/racket/racket/?path=pkgs/racket-doc",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            false));
-
-    console.log(ParseSource("git://github.com/rmculpepper/asn1.git?path=asn1-doc",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            true));
-    console.log(ParseSource("git://github.com/rmculpepper/asn1",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            true));
-    console.log(ParseSource("git://github.com/rmculpepper/asn1",
-                            '(lib "asn1/scribblings/asn1.scrbl")',
-                            false));
-}
-
-function AddPartTitleOnClick(elem) {
-    var mod_path = elem.getAttribute("x-source-module");
-    var tag = elem.getAttribute("x-part-tag");
-    var source_pkg = elem.getAttribute("x-source-pkg");
-
-    // create here to share
-    var info = document.createElement("div");
-
-
-    // tag is not needed, but this way we can add the element in only one place
-    // avoid failing on browser that don't have `fetch`
-    if (mod_path && source_pkg && tag && window.fetch) {
-
-        var cached = cache[mod_path]
-        if (cached) {
-            AddSourceElement(cached[0], mod_path, cached[1], info);
-        }
-        else {
-            fetch("https://pkgs.racket-lang.org/pkg/" + source_pkg + ".json")
-                .then(function (response) { return response.json(); })
-                .then(function (data) {
-                    var vers = data["versions"] || {};
-                    var def = vers["default"] || {};
-                    var source = def["source"] || undefined;
-                    var collection = data["collection"];
-                    if (source) {
-                        cache[mod_path] = [source, collection];
-                        AddSourceUrl(source, mod_path, collection, info);
-                    }
-                });
-        }
-    }
-
-    if (mod_path && tag) {
-        // Might not be present:
-        var prefixes = elem.getAttribute("x-part-prefixes");
-
-        info.className = "RPartExplain";
-
-        /* The "top" tag refers to a whole document: */
-        var is_top = (tag == "\"top\"");
-        info.appendChild(document.createTextNode("Link to this "
-                                                 + (is_top ? "document" : "section")
-                                                 + " with "));
-
-        /* Break `secref` into two lines if the module path and tag
-           are long enough: */
-        var is_long = (is_top ? false : ((mod_path.length
-                                          + tag.length
-                                          + (prefixes ? (16 + prefixes.length) : 0))
-                                         > 60));
-
-        var line1 = document.createElement("div");
-        var line1x = ((is_long && prefixes) ? document.createElement("div") : line1);
-        var line2 = (is_long ? document.createElement("div") : line1);
-
-        /* Construct a `secref` call with suitable syntax coloring: */
-        addSpan(line1, "\xA0@", "RktRdr");
-        addSpan(line1, (is_top ? "other-doc" : "secref"), "RktSym");
-        addSpan(line1, "[", "RktPn");
-        if (!is_top)
-            addSpan(line1, tag, "RktVal");
-        if (is_long) {
-            /* indent additional lines: */
-            if (prefixes)
-                addSpan(line1x, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
-            addSpan(line2, "\xA0\xA0\xA0\xA0\xA0\xA0\xA0\xA0", "RktPn");
-        }
-        if (prefixes) {
-            addSpan(line1x, " #:tag-prefixes ", "RktPn");
-            addSpan(line1x, "'", "RktVal");
-            addSpan(line1x, prefixes, "RktVal");
-        }
-        if (!is_top)
-            addSpan(line2, " #:doc ", "RktPn");
-        addSpan(line2, "'", "RktVal");
-        addSpan(line2, mod_path, "RktVal");
-        addSpan(line2, "]", "RktPn");
-
-        info.appendChild(line1);
-        if (is_long)
-            info.appendChild(line1x);
-        if (is_long)
-            info.appendChild(line2);
-
-        info.style.display = "none";
-
-        /* Add the new element afterthe header: */
-        var n = elem.nextSibling;
-        if (n)
-            elem.parentNode.insertBefore(info, n);
-        else
-            elem.parentNode.appendChild(info);
-
-        /* Clicking the information button shows the explanation element: */
-        const heading = elem.querySelector('.heading-source');
-        if (heading) {
-          heading.onclick = function () {
-            if (info.style.display === "none")
-                info.style.display = "block";
-            else
-                info.style.display = "none";
-          }
-        }
-    }
-}

scribblings/manual-style.css

@@ -1,815 +0,0 @@
-
-/* See the beginning of "scribble.css".
-   This file is used by the `scribble/manual` language, along with
-   "manual-racket.css". */
-
-@import url("manual-fonts.css");
-
-* {
-    margin: 0;
-    padding: 0;
-}
-
-@media all {html {font-size: 15px;}}
-@media all and (max-width:940px){html {font-size: 14px;}}
-@media all and (max-width:850px){html {font-size: 13px;}}
-@media all and (max-width:830px){html {font-size: 12px;}}
-@media all and (max-width:740px){html {font-size: 11px;}}
-
-/* CSS seems backward: List all the classes for which we want a
-   particular font, so that the font can be changed in one place.  (It
-   would be nicer to reference a font definition from all the places
-   that we want it.)
-
-   As you read the rest of the file, remember to double-check here to
-   see if any font is set. */
-
-/* Monospace: */
-.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft {
-    font-family: 'Fira-Mono', monospace;
-    white-space: inherit;
-    font-size: 1rem;
-}
-
-/* Enable heading-source */
-.button-group > .heading-source {
-    visibility: inherit;
-    cursor: pointer;
-    user-select: none;
-    color: gray;
-}
-
-/* embolden the "Racket Guide" and "Racket Reference" links on the TOC */
-/* there isn't an obvious tag in the markup that designates the top TOC page, which is called "start.scrbl" */
-/* nor a tag that designates these two links as special */
-/* so we'll use this slightly tortured sibling selector that hooks onto the h1 tag */
-h1[x-source-module='(lib "scribblings/main/start.scrbl")'] ~ table a[href="guide/index.html"], 
-h1[x-source-module='(lib "scribblings/main/start.scrbl")'] ~ table a[href="reference/index.html"] {
-  font-weight: bold;
-}
-
-
-h1 .stt {
-    font-size: 2.3rem;
-    /* prevent automatic bolding from h1 */
-    font-weight: 400;
-}
-
-.toptoclink .stt {
-    font-size: inherit;
-}
-.toclink .stt {
-    font-size: 90%;
-}
-
-.RpackageSpec .stt {
-    font-weight: 300;
-    font-family: 'Fira-Mono', monospace;
-    font-size: 0.9rem;
-}
-
-h2 .stt, h3 .stt, h4 .stt, h5 .stt {
-    color: #333;
-    font-size: 1.65rem;
-    font-weight: 400;
-}
-
-
-/* Serif: */
-.main, .refcontent, .tocview, .tocsub, .sroman, i {
-    font-family: 'Charter-Racket', serif;
-    font-size: 1.18rem;
-/* Don't use font-feature-settings with Charter, 
-it fouls up loading for reasons mysterious */
-/*    font-feature-settings: 'tnum' 1, 'liga' 0; */
-}
-
-
-/* Sans-serif: */
-.version, .versionNoNav, .ssansserif, .navfamily, .famlink {
-    font-family: 'Fira', sans-serif;
-}
-
-/* used mostly for DrRacket menu commands */
-.ssansserif {
-    font-family: 'Fira', sans-serif;
-    font-size: 0.9em;
-}
-
-.tocset .ssansserif {
-    font-size: 100%;
-}
-
-/* ---------------------------------------- */
-
-p, .SIntrapara {
-    display: block;
-    margin: 0 0 1em 0;
-    line-height: 1.4;
-}
-
-.compact {
-  padding: 0 0 1em 0;
-}
-
-li {
-    list-style-position: outside;
-    margin-left: 1.2em;
-}
-
-h1, h2, h3, h4, h5, h6, h7, h8 {
-    font-family: 'Fira', sans-serif;
-    font-weight: 300;
-    font-size: 1.6rem;
-    color: #333;
-    margin-top: inherit;
-    margin-bottom: 1rem;
-    line-height: 1.25;
-
-}
-
-h2, h3, h4, h5, h6, h7, h8 {
-    border-top: 1px solid black;
-}
-
-
-
-h1 { /* per-page main title */
-    font-family: 'Cooper-Hewitt';
-    margin-top: 4rem;
-    font-size: 2.3rem;
-    font-weight: bold;
-    line-height: 1.2;
-    width: 90%;
-    /* a little nudge to make text visually lower than 4rem rule in left margin */
-    position: relative;
-    top: 6px;
-}
-
-h2, h3, h4, h5, h6, h7, h8 {
-    margin-top: 2em;
-    padding-top: 0.1em;
-    margin-bottom: 0.75em;
-}
-
-/* ---------------------------------------- */
-/* Main */
-
-body {
-    color: black;
-    background-color: white;
-}
-
-.maincolumn {
-    width: auto;
-    margin-top: 4rem;
-    margin-left: 17rem;
-    margin-right: 2rem;
-    margin-bottom: 10rem; /* to avoid fixed bottom nav bar */
-    max-width: 700px;
-    min-width: 370px; /* below this size, code samples don't fit */
-}
-
-a {
-    text-decoration: inherit;
-}
-
-a, .toclink, .toptoclink, .tocviewlink, .tocviewselflink, .tocviewtoggle, .plainlink, 
-.techinside, .techoutside:hover, .techinside:hover {
-    color: #07A;
-}
-
-a:hover {
-    text-decoration: underline;
-}
-
-
-/* ---------------------------------------- */
-/* Navigation */
-
-.navsettop, .navsetbottom {
-    left: 0;
-    width: 15rem;
-    height: 6rem;
-    font-family: 'Fira', sans-serif;
-    font-size: 0.9rem;
-    border-bottom: 0px solid hsl(216, 15%, 70%);
-    background-color: inherit;
-    padding: 0;
-}
-
-.navsettop {
-    position: fixed;
-    z-index: 2;
-    background: #a7b0be;
-    top: 0;
-    left: 0;
-    margin-bottom: 0;
-    border-bottom: 0;
-}
-
-.navsettop a, .navsetbottom a {
-    color: black;
-}
-
-.navsettop a:hover, .navsetbottom a:hover {
-    background: hsl(216, 78%, 95%);
-    text-decoration: none;
-}
-
-.navleft, .navright {
-    position: static;
-    float: none;
-    margin: 0;
-    white-space: normal;
-}
-
-
-.navleft a {
-    display: inline-block;
-}
-
-.navright a {
-    display: inline-block;
-    text-align: center;
-}
-
-.navleft a, .navright a, .navright span {
-    display: inline-block;
-    padding: 0.5rem;
-    min-width: 1rem;
-}
-
-
-.navright {
-    white-space: nowrap;
-}
-
-
-.navsetbottom {
-    display: none;
-}
-
-.nonavigation {
-    color: #889;
-}
-
-.searchform {
-    display: block;
-    margin: 0;
-    padding: 0;
-    border-bottom: 1px solid #eee;
-    height: 4rem;
-}
-
-.nosearchform {
-    margin: 0;
-    padding: 0;
-    height: 4rem;
-}
-
-.searchbox {
-    font-size: 0.9rem;
-    width: 12rem;
-    margin: 1rem;
-    padding: 0.25rem 0.4rem ;
-    vertical-align: middle;
-    background-color: white;
-    font-family: 'Fira-Mono', monospace;
-}
-
-
-#search_box {
-    font-family: 'Fira-Mono', monospace;
-    font-size: 1rem;
-    padding: 0.25rem 0.3rem ;
-}
-
-/* Default to local view. Global will specialize */
-.plt_global_only { display: none; }
-.plt_local_only { display: block; }
-
-/* ---------------------------------------- */
-/* Version */
-
-.versionbox {
-    position: absolute;
-    float: none;
-    top: 0.25rem;
-    left: 17rem;
-    z-index: 11000;
-    height: 2em;
-    font-size: 70%;
-    font-weight: lighter;
-    width: inherit;
-    margin: 0;
-}
-.version, .versionNoNav {
-    font-size: inherit;
-}
-.version:before, .versionNoNav:before {
-    content: "v";
-}
-
-/* ---------------------------------------- */
-/* Language Family */
-
-.navfamily {
-    position: sticky;
-    top: 0;
-    left: 100%;
-    width: 13em;
-    margin-top: -4.75em;
-    margin-right: -15em;
-    font-size: 70%;
-    font-weight: lighter;
-    height: auto;
-    padding-top: 0.5em;
- }
-
-/* ---------------------------------------- */
-/* Margin notes */
-
-/* cancel scribble.css styles: */
-.refpara, .refelem {
-  position: static;
-  float: none;
-  height: auto;
-  width: auto;
-  margin: 0;
-}
-
-.refcolumn {
-    position: static;
-    display: block;
-    width: auto;
-    font-size: inherit;
-    margin: 2rem;
-    margin-left: 2rem;
-    padding: 0.5em;
-    padding-left: 0.75em;
-    padding-right: 1em;
-    background: hsl(60, 29%, 94%);
-    border: 1px solid #ccb;
-    border-left: 0.4rem solid #ccb;
-}
-
-
-/* slightly different handling for margin-note* on narrow screens */
-@media all and (max-width:1340px) {
-     span.refcolumn {
-         float: right;
-         width: 50%;
-         margin-left: 1rem;
-         margin-bottom: 0.8rem;   
-         margin-top: 1.2rem; 
-     }
-
-     .navfamily {
-         position: static;
-         margin: -4.75em 0em 0em 0em;
-     }
-}
-
-.refcontent, .refcontent p {
-    line-height: 1.5;
-    margin: 0;
-}
-
-.refcontent p + p {
-    margin-top: 1em;
-}
-
-.refcontent a {
-    font-weight: 400;
-}
-
-.refpara, .refparaleft {
-    top: -1em;
-}
-
-
-@media all and (max-width:600px) {
-    .refcolumn {
-        margin-left: 0;
-        margin-right: 0;
-    }
-}
-
-
-@media all and (min-width:1340px) {
-    .refcolumn {
-        margin: 0 -22.5rem 1rem 0;
-        float: right;
-        clear: right;
-        width: 18rem;
-    }
-}
-
-.refcontent {
-    font-family: 'Fira', sans-serif;
-    font-size: 1rem;
-    line-height: 1.6;
-    margin: 0 0 0 0;
-}
-
-
-.refparaleft, .refelemleft {
-    position: relative;
-    float: left;
-    right: 2em;
-    height: 0em;
-    width: 13em;
-    margin: 0em 0em 0em 0em;
-    display: contents;
-}
-
-.refcolumnleft {
-    background-color: hsl(60, 29%, 94%);
-    display: block;
-    position: relative;
-    width: 13em;
-    font-size: 85%;
-    border: 0.5em solid hsl(60, 29%, 94%);
-    margin: 0 0 0 0;
-}
-
-
-/* ---------------------------------------- */
-/* Table of contents, left margin */
-
-.tocset {
-    position: fixed;
-    z-index: 2;
-    overflow-y: scroll;
-    float: none;
-    left: 0;
-    top: 0rem;
-    bottom: 0;
-    width: 14rem;
-    padding: 0rem 0.5rem 0.5rem 0.5rem;
-    background-color: hsl(216, 15%, 70%);
-    border-top: 6rem solid hsl(216, 15%, 70%);
-}
-
-.tocset td {
-    vertical-align: text-top;
-    padding-bottom: 0.4rem;
-    padding-left: 0.2rem;
-    line-height: 1.1;
-    font-family: 'Fira', sans-serif;
-}
-
-.tocset td a {
-    color: black;
-    font-weight: 400;
-}
-
-
-.tocview {
-    text-align: left;
-    background-color: inherit;
-    margin-top: 1em;
-}
-
-
-.tocview td, .tocsub td {
-    line-height: 1.3;
-}
-
-
-.tocview table, .tocsub table {
-    width: 90%;
-}
-
-.tocset td a.tocviewselflink {
-    font-weight: lighter;
-    font-size: 110%; /* monospaced styles below don't need to enlarge */
-    color: white;
-}
-
-.tocviewselflink {
-    text-decoration: none;
-}
-
-.tocsub {
-    text-align: left;
-    margin-top: 0.5em;
-    background-color: inherit;
-}
-
-.tocviewlist, .tocsublist {
-    margin-left: 0.2em;
-    margin-right: 0.2em;
-    padding-top: 0.2em;
-    padding-bottom: 0.2em;
-}
-.tocviewlist table {
-    font-size: 82%;
-}
-
-.tocviewlisttopspace {
-    margin-bottom: 1em;
-}
-
-.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
-    margin-left: 0.4em;
-    border-left: 1px solid #99a;
-    padding-left: 0.8em;
-}
-.tocviewsublist {
-    margin-bottom: 1em;
-}
-.tocviewsublist table,
-.tocviewsublistonly table,
-.tocviewsublisttop table,
-.tocviewsublistbottom table,
-table.tocsublist {
-    font-size: 1rem;
-}
-
-.tocviewsublist td, 
-.tocviewsublistbottom td, 
-.tocviewsublisttop td, 
-.tocsub td,
-.tocviewsublistonly td {
-    font-size: 90%;
-}
-
-/* shrink the monospaced text (`stt`) within nav */
-.tocviewsublist td .stt, 
-.tocviewsublistbottom td .stt, 
-.tocviewsublisttop td .stt, 
-.tocsub td .stt,
-.tocviewsublistonly td .stt {
-    font-size: 95%;
-}
-
-
-.tocviewtoggle {
-    font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
-}
-
-.tocsublist td {
-    padding-left: 0.5rem;
-    padding-top: 0.25rem;
-    text-indent: 0;
-}
-
-.tocsublinknumber {
-    font-size: 100%;
-}
-
-.tocsublink {
-    font-size: 82%;
-    text-decoration: none;
-}
-
-.tocsubseclink {
-    font-size: 100%;
-    text-decoration: none;
-}
-
-.tocsubnonseclink {
-    font-size: 82%;
-    text-decoration: none;
-    margin-left: 1rem;
-    padding-left: 0;
-    display: inline-block;
-}
-
-/* the label "on this page" */
-.tocsubtitle {
-    display: block;
-    font-size: 62%;
-    font-family: 'Fira', sans-serif;
-    font-weight: bolder;
-    font-style: normal;
-    letter-spacing: 2px;
-    text-transform: uppercase;
-    margin: 0.5em;
-}
-
-.toptoclink {
-    font-weight: bold;
-    font-size: 110%;
-    margin-bottom: 0.5rem;
-    margin-top: 1.5rem;
-    display: inline-block;
-}
-
-.toclink {
-    font-size: inherit;
-}
-
-/* ---------------------------------------- */
-/* Some inline styles */
-
-.indexlink {
-    text-decoration: none;
-}
-
-pre {
-  margin-left: 2em;
-}
-
-blockquote {
-  margin-left: 2em;
-  margin-right: 2em;
-  margin-bottom: 1em;
-}
-
-.SCodeFlow {
-    border-left: 1px dotted black;
-    padding-left: 1em;
-    padding-right: 1em;
-    margin-top: 1em;
-    margin-bottom: 1em;
-    margin-left: 0em;
-    margin-right: 2em;
-    white-space: nowrap;
-    line-height: 1.5;
-}
-
-.SCodeFlow img {
-    margin-top: 0.5em;
-    margin-bottom: 0.5em;
-}
-
-/* put a little air between lines of code sample */
-/* Fira Mono appears taller than Source Code Pro */
-.SCodeFlow td {
-    padding-bottom: 1px;
-}
-
-.boxed {
-    margin: 0;
-    margin-top: 2em;
-    padding: 0.25em;
-    padding-top: 0.3em;
-    padding-bottom: 0.4em;
-    background: #f3f3f3;
-    box-sizing:border-box;
-    border-top: 1px solid #99b;
-    background: hsl(216, 78%, 95%);
-    background: -moz-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 62%, 95%) 100%);
-    background: -webkit-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 62%, 95%) 100%);
-    background: -o-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 62%, 95%) 100%);
-    background: -ms-linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 62%, 95%) 100%);
-    background: linear-gradient(to bottom left, hsl(0, 0%, 99%) 0%, hsl(216, 62%, 95%) 100%);
-}
-
-blockquote > blockquote.SVInsetFlow {
-/* resolves issue in e.g. /reference/notation.html */
-    margin-top: 0em;
-}
-
-.leftindent .SVInsetFlow { /* see e.g. section 4.5 of Racket Guide */
-    margin-top: 1em;
-    margin-bottom: 1em;
-}
-
-.SVInsetFlow a, .SCodeFlow a {
-    color: #07A;
-}
-
-.SubFlow {
-    display: block;
-    margin: 0em;
-}
-
-.boxed {
-    width: 100%;
-    background-color: inherit;
-}
-
-.techoutside       { text-decoration: none; }
-
-.SAuthorListBox {
-    position: static;
-    float: none;
-    font-family: 'Fira', sans-serif;
-    font-weight: 300;
-    font-size: 110%;
-    margin-top: 1rem;
-    margin-bottom: 2rem;
-    width: 30rem;
-    height: auto;
-}
-
-.author > a { /* email links within author block */
-    font-weight: inherit;
-    color: inherit;
-}
-
-.SAuthorList {
-    font-size: 82%;
-}
-.SAuthorList:before {
-    content: "by ";
-}
-.author {
-    display: inline;
-    white-space: nowrap;
-}
-
-/* phone + tablet styles */
-
-@media all and (max-width:720px){
-
-
-    @media all and (max-width:720px){
-
-        @media all {html {font-size: 15px;}}
-        @media all and (max-width:700px){html {font-size: 14px;}}
-        @media all and (max-width:630px){html {font-size: 13px;}}
-        @media all and (max-width:610px){html {font-size: 12px;}}
-        @media all and (max-width:550px){html {font-size: 11px;}}
-        @media all and (max-width:520px){html {font-size: 10px;}}
-
-        .navsettop, .navsetbottom {
-            display: flex;
-            position: absolute;
-            width: 100%;
-            height: 4rem;
-            border: 0;
-            background-color: hsl(216, 15%, 70%);
-            align-items: center;
-        }
-
-        .tocsetoverlay .navsettop {
-            position: fixed;
-        }
-
-        .navleft {
-            flex: 1;
-        }
-
-        .searchform {
-            display: inline;
-            border: 0;
-        }
-
-        .searchbox {
-            margin-top: 0;
-            margin-bottom: 0;
-        }
-
-        .navleft .tocsettoggle {
-            display: initial;
-        }
-
-        .navright {
-            margin-right: 1.3rem;
-            border: 0px solid red;
-        }
-
-        .navsetbottom {
-            display: block;
-            margin-top: 8rem;
-        }
-
-        .tocset {
-            display: none;
-            border-top-width: 4rem;
-        }
-
-        .tocsetoverlay .tocset {
-            display: block;
-        }
-
-        .versionbox {
-            top: 4.5rem;
-            left: 1rem; /* same distance as main-column */
-            z-index: 1;
-            height: 2em;
-            font-size: 70%;
-            font-weight: lighter;
-        }
-
-        .navfamily {
-            position: static;
-            margin: -3.25em 0em 0em 0em;
-        }
-
-        .maincolumn {
-            margin-left: 1em;
-            margin-top: 7rem;
-            margin-bottom: 0rem;
-        }
-
-    }
-
-}
-
-/* print styles : hide the navigation elements */
-@media print {
-    .tocset,
-    .navsettop,
-    .navsetbottom { display: none; }
-    .maincolumn {
-        width: auto;
-        margin-right: 13em;
-        margin-left: 0;
-    }
-}

scribblings/racket.css

@@ -1,251 +0,0 @@
-
-/* See the beginning of "scribble.css". */
-
-/* Monospace: */
-.RktIn, .RktRdr, .RktPn, .RktMeta,
-.RktMod, .RktKw, .RktVar, .RktSym,
-.RktRes, .RktOut, .RktCmt, .RktVal,
-.RktBlk {
-  font-family: monospace;
-  white-space: inherit;
-}
-
-/* Serif: */
-.inheritedlbl {
-  font-family: serif;
-}
-
-/* Sans-serif: */
-.RBackgroundLabelInner {
-  font-family: sans-serif;
-}
-
-/* ---------------------------------------- */
-/* Inherited methods, left margin */
-
-.inherited {
-  width: 100%;
-  margin-top: 0.5em;
-  text-align: left;
-  background-color: #ECF5F5;
-}
-
-.inherited td {
-  font-size: 82%;
-  padding-left: 1em;
-  text-indent: -0.8em;
-  padding-right: 0.2em;
-}
-
-.inheritedlbl {
-  font-style: italic;
-}
-
-/* ---------------------------------------- */
-/* Racket text styles */
-
-.RktIn {
-  color: #cc6633;
-  background-color: #eeeeee;
-  white-space: pre;
-}
-
-.RktInBG {
-  background-color: #eeeeee;
-}
-
-.RktRdr {
-}
-
-.RktPn {
-  color: #843c24;
-}
-
-.RktMeta {
-  color: black;
-}
-
-.RktMod {
-  color: black;
-}
-
-.RktOpt {
-  color: black;
-  font-style: italic;
-}
-
-.RktKw {
-  color: black;
-}
-
-.RktErr {
-  color: red;
-  font-style: italic;
-}
-
-.RktVar {
-  color: #262680;
-  font-style: italic;
-}
-
-.RktSym {
-  color: #262680;
-}
-
-.RktSymDef { /* used with RktSym at def site */
-}
-
-.RktValLink {
-  text-decoration: none;
-  color: blue;
-}
-
-.RktValDef { /* used with RktValLink at def site */
-}
-
-.RktModLink {
-  text-decoration: none;
-  color: blue;
-}
-
-.RktStxLink {
-  text-decoration: none;
-  color: black;
-}
-
-.RktStxDef { /* used with RktStxLink at def site */
-}
-
-.RktRes {
-  color: #0000af;
-}
-
-.RktOut {
-  color: #960096;
-}
-
-.RktCmt {
-  color: #c2741f;
-}
-
-.RktVal {
-  color: #228b22;
-}
-
-/* ---------------------------------------- */
-/* Some inline styles */
-
-.together {
-  width: 100%;
-}
-
-.prototype, .argcontract, .RBoxed {
-  white-space: nowrap;
-}
-
-.prototype td {
-  vertical-align: text-top;
-}
-
-.RktBlk {
-  white-space: inherit;
-  text-align: left;
-}
-
-.RktBlk tr {
-  white-space: inherit;
-}
-
-.RktBlk td {
-  vertical-align: baseline;
-  white-space: inherit;
-}
-
-.argcontract td {
-  vertical-align: text-top;
-}
-
-.highlighted {
-  background-color: #ddddff;
-}
-
-.defmodule {
-  width: 100%;
-  background-color: #F5F5DC;
-}
-
-.specgrammar {
-  float: right;
-}
-
-.RBibliography td {
-  vertical-align: text-top;
-}
-
-.leftindent {
- margin-left: 1em;
- margin-right: 0em;
-}
-
-.insetpara {
- margin-left: 1em;
- margin-right: 1em;
-}
-
-.Rfilebox {
-}
-
-.Rfiletitle {
-  text-align: right;
-  margin: 0em 0em 0em 0em;
-}
-
-.Rfilename {
-  border-top: 1px solid #6C8585;
-  border-right: 1px solid #6C8585;
-  padding-left: 0.5em;
-  padding-right: 0.5em;
-  background-color: #ECF5F5;
-}
-
-.Rfilecontent {
-  margin: 0em 0em 0em 0em;
-}
-
-.RpackageSpec {
-  padding-right: 0.5em;
-}
-
-/* ---------------------------------------- */
-/* For background labels */
-
-.RBackgroundLabel {
-   float: right;
-   width: 0px;
-   height: 0px;
-}
-
-.RBackgroundLabelInner {
-   position: relative;
-   width: 25em;
-   left: -25.5em;
-   top: 0px;
-   text-align: right;
-   color: white;
-   z-index: 0;
-   font-weight: bold;
-}
-
-.RForeground {
-   position: relative;
-   left: 0px;
-   top: 0px;
-   z-index: 1;
-}
-
-/* ---------------------------------------- */
-/* History */
-
-.SHistory {
-  font-size: 82%;
-}

scribblings/scribble-common.js

@@ -1,263 +0,0 @@
-// Common functionality for PLT documentation pages
-
-// Page Parameters ------------------------------------------------------------
-
-var plt_root_as_query = false;
-
-function GetURL() {
-  return new URL(location);
-}
-
-function GetPageArgs() {
-  return GetURL().searchParams;
-}
-
-function GetPageQueryString() {
-  return GetPageArgs().toString();
-}
-
-function GetPageArg(key, def) {
-  return GetPageArgs().get(key) || def;
-}
-
-function MergePageArgsIntoLink(a) {
-  if ((GetPageArgs().size === 0 || !a.dataset.pltdoc) && !plt_root_as_query) return;
-  a.href = MergePageArgsIntoUrl(a.href);
-}
-
-function MergePageArgsIntoUrl(href) {
-  const url = new URL(href, window.location.href);
-  MergePageArgsIntoUrlObject(url);
-  return url.href;
-}
-
-function MergePageArgsIntoUrlObject(url) {
-  for (const [key, val] of GetPageArgs()) {
-    if (key[0] == "q") continue; // use "q" to mean "don't propagate automatcially"
-    if (url.searchParams.has(key)) continue;
-    url.searchParams.append(key, val)
-  }
-  if (plt_root_as_query && !url.searchParams.has("PLT_Root")) {
-      url.searchParams.append("PLT_Root", plt_root_as_query);
-  }
-}
-
-// Cookies --------------------------------------------------------------------
-
-// Actually, try localStorage (a la HTML 5), first.
-
-function GetCookie(key, def) {
-  try {
-    var v = localStorage[key];
-    if (!v) v = def;
-    return v;
-  } catch (e) {
-    var i, cookiestrs;
-    try {
-      if (document.cookie.length <= 0) return def;
-      cookiestrs = document.cookie.split(/; */);
-    } catch (e) { return def; }
-    for (i = 0; i < cookiestrs.length; i++) {
-      var cur = cookiestrs[i];
-      var eql = cur.indexOf('=');
-      if (eql >= 0 && cur.substring(0,eql) == key)
-        return unescape(cur.substring(eql+1));
-    }
-    return def;
-  }
-}
-
-function SetCookie(key, val) {
-  try {
-    localStorage[key] = val;
-  } catch(e) {
-    var d = new Date();
-    d.setTime(d.getTime()+(365*24*60*60*1000));
-    try {
-      document.cookie =
-        key + "=" + escape(val) + "; expires="+ d.toGMTString() + "; path=/";
-    } catch (e) {}
-  }
-}
-
-// note that this always stores a directory name, ending with a "/"
-function SetPLTRoot(ver, relative) {
-    var root = location.protocol + "//" + location.host
-        + NormalizePath(location.pathname.replace(/[^\/]*$/, relative));
-    if (location.protocol == "file:") {
-        // local storage or cookies are not going to work in modern browsers,
-        // so add a query parameter to all URLs
-        plt_root_as_query=root
-    } else {
-        SetCookie("PLT_Root."+ver, root);
-    }
-}
-
-// adding index.html works because of the above
-function GotoPLTRoot(ver, root_relative, here_to_root_relative) {
-  // the relative path is optional, default goes to the toplevel start page
-  if (!root_relative) root_relative = "index.html";
-  if (here_to_root_relative == undefined) here_to_root_relative = "../"
-  var famroot = false;
-  if (root_relative == "index.html") {
-    famroot = (GetPageArg("fam", false) ? GetPageArg("famroot", false) : false)
-    if (famroot) {
-      root_relative = famroot + "/index.html";
-    }
-  }
-
-  var u = GetRootPath(ver);
-  if (u == null) {
-    if (famroot) {
-      location = MergePageArgsIntoUrl(here_to_root_relative + famroot + "/index.html");
-      return false;
-    }
-    // no cookie and no famroot => follow href, instead
-    return true;
-  }
-  location = MergePageArgsIntoUrl(u + root_relative);
-  return false;
-}
-
-function GetRootPath(ver) {
-    var u = GetCookie("PLT_Root."+ver, null);
-    if (u != null)
-        return u;
-
-    // via query argument? (especially for `file://` URLs)
-    u = GetPageArg("PLT_Root", null)
-    if (u != null)
-        return u;
-
-    // use root specified by local-redirect wrapper, if present
-    if (typeof user_doc_root != "undefined")
-        return user_doc_root;
-
-    return null;
-}
-
-// Utilities ------------------------------------------------------------------
-
-var normalize_rxs = [/\/\/+/g, /\/\.(\/|$)/, /\/[^\/]*\/\.\.(\/|$)/];
-function NormalizePath(path) {
-  var tmp, i;
-  for (i = 0; i < normalize_rxs.length; i++)
-    while ((tmp = path.replace(normalize_rxs[i], "/")) != path) path = tmp;
-  return path;
-}
-
-// `noscript' is problematic in some browsers (always renders as a
-// block), use this hack instead (does not always work!)
-// document.write("<style>mynoscript { display:none; }</style>");
-
-// Interactions ---------------------------------------------------------------
-
-function DoSearchKey(event, field, ver, top_path) {
-  var val = field.value;
-  if (event && event.key === 'Enter') {
-    var u = GetRootPath(ver);
-    if (u == null) u = top_path; // default: go to the top path
-    u += "search/index.html?q=" + encodeURIComponent(val);
-    u = MergePageArgsIntoUrl(u);
-    location = u;
-    return false;
-  }
-  return true;
-}
-
-function TocviewToggle(glyph, id) {
-  var s = document.getElementById(id).style;
-  var expand = s.display == "none";
-  s.display = expand ? "block" : "none";
-  glyph.innerHTML = expand ? "&#9660;" : "&#9658;";
-}
-
-function TocsetToggle() {
-  document.body.classList.toggle("tocsetoverlay");
-}
-
-// Page Init ------------------------------------------------------------------
-
-// Note: could make a function that inspects and uses window.onload to chain to
-// a previous one, but this file needs to be required first anyway, since it
-// contains utilities for all other files.
-var on_load_funcs = [];
-function AddOnLoad(fun) { on_load_funcs.push(fun); }
-window.onload = function() {
-  for (var i=0; i<on_load_funcs.length; i++) on_load_funcs[i]();
-};
-
-AddOnLoad(function(){
-    var links = document.getElementsByTagName("a");
-    for (var i=0; i<links.length; i++) MergePageArgsIntoLink(links[i]);
-    var label = GetPageArg("ctxtname",false);
-    if (!label) return;
-    var indicator = document.getElementById("contextindicator");
-    if (!indicator) return;
-    indicator.innerHTML = label;
-    indicator.style.display = "block";
-  });
-
-// Pressing "S" or "s" focuses on the "...search manuals..." text field
-AddOnLoad(function(){
-  window.addEventListener("keyup", function(e) {
-    if ((e.key === 's' || e.key === 'S') && e.target === document.body) {
-      var searchBox = document.getElementById('searchbox');
-      if (searchBox) {
-        searchBox.focus();
-      }
-    }
-  }, false);
-});
-
-AddOnLoad(function(){
-  var es = document.getElementsByClassName("family-navigation");
-  if (es.length > 0) {
-    var fams = es[0].dataset.familynav.split(/,/);
-    var fam = GetPageArg("famroot", false) && GetPageArg("fam", false);
-    if (!fam) fam = "Racket";
-    if (fams.indexOf(fam) == -1) {
-      for (var i=0; i < es.length; i++) {
-        es[i].style.display = "inline-block";
-      }
-    }
-  }
-});
-
-AddOnLoad(function(){
-  var es = document.getElementsByClassName("navfamily");
-  for (var i=0; i < es.length; i++) {
-    var e = es[i];
-    if (e.dataset.fam != undefined) {
-      var fams = e.dataset.fam.split(/,/);
-      var fam = GetPageArg("fam", false);
-      if (!fam) fam = "Racket";
-      var link = document.createElement('a');
-      var root = GetRootPath(e.dataset.version)
-      var family_url;
-      if (root == null) {
-        family_url = new URL(e.dataset.famPath + "family/index.html", window.location.href);
-      } else {
-        family_url = new URL(root + "family/index.html", window.location.href);
-      }
-      family_url.searchParams.append("qfrom", window.location.href)
-      MergePageArgsIntoUrlObject(family_url);
-      if (fams.indexOf(fam) == -1) {
-        var nav_as = document.createElement('div');
-        link.textContent = "navigating as " + fam;
-        link.href = family_url
-        nav_as.appendChild(link)
-        e.appendChild(nav_as)
-      } else {
-        var link = document.createElement('a');
-        var span = e.children[0]
-        link.textContent = span.textContent;
-        link.href = family_url
-        span.textContent = ''; // Clear span
-        e.removeChild(span);
-        link.appendChild(span);
-        e.appendChild(link);
-      }
-    }
-  }
-});

scribblings/scribble.css

@@ -1,587 +0,0 @@
-
-/* This file is used by default by all Scribble documents.
-   See also "manual.css", which is added by default by the
-   `scribble/manual` language. */
-
-/* CSS seems backward: List all the classes for which we want a
-   particular font, so that the font can be changed in one place.  (It
-   would be nicer to reference a font definition from all the places
-   that we want it.)
-
-   As you read the rest of the file, remember to double-check here to
-   see if any font is set. */
-
-/* Monospace: */
-.maincolumn, .refpara, .refelem, .tocset, .stt, .hspace, .refparaleft, .refelemleft, .reffootnote {
-  font-family: monospace;
-}
-
-/* Serif: */
-.main, .refcontent, .tocview, .tocsub, .sroman, i {
-  font-family: serif;
-}
-
-/* Sans-serif: */
-.version, .versionNoNav, .ssansserif, .navfamily {
-  font-family: sans-serif;
-}
-.ssansserif {
-  font-size: 80%;
-  font-weight: bold;
-}
-
-/* Emphasis: alternate italics and normal as we nest */
-.emph {
-  font-style: italic;
-}
-.emph .emph {
-  font-style: normal;
-}
-.emph .emph .emph {
-  font-style: italic;
-}
-.emph .emph .emph .emph {
-  font-style: normal;
-}
-.emph .emph .emph .emph .emph {
-  font-style: italic;
-}
-.emph .emph .emph .emph .emph .emph {
-  font-style: normal;
-}
-
-/* ---------------------------------------- */
-
-p, .SIntrapara {
-  display: block;
-  margin: 1em 0;
-}
-
-h1 { /* per-page main title */
-  font-size: 1.5em;
-  margin-top: 0;
-}
-
-h2, h3, h4, h5, h6, h7, h8 {
-  margin-top: 1.75em;
-  margin-bottom: 0.5em;
-}
-
-h2 {
-  font-size: 1.17em;
-}
-
-h3 {
-  font-size: 1.00em;
-}
-
-h4 {
-  font-size: 0.83em;
-}
-
-.SSubSubSubSection {
-  font-weight: bold;
-  font-size: 0.83em; /* should match h5; from HTML 4 reference */
-}
-
-/* Needed for browsers like Opera, and eventually for HTML 4 conformance.
-   This means that multiple paragraphs in a table element do not have a space
-   between them. */
-table p {
-  margin-top: 0;
-  margin-bottom: 0;
-}
-
-/* ---------------------------------------- */
-/* Main */
-
-body {
-  color: black;
-  background-color: #ffffff;
-}
-
-table td {
-  padding-left: 0;
-  padding-right: 0;
-}
-
-.maincolumn {
-  width: 43em;
-  margin-right: -40em;
-  margin-left: 15em;
-}
-
-.main {
-  text-align: left;
-}
-
-/* ---------------------------------------- */
-/* Navigation */
-
-.navsettop, .navsetbottom {
-  background-color: #f0f0e0;
-  padding: 0.25em 0 0.25em 0;
-}
-
-.navsettop {
-  margin-bottom: 1.5em;
-  border-bottom: 2px solid #e0e0c0;
-}
-
-.navsetbottom {
-  margin-top: 2em;
-  border-top: 2px solid #e0e0c0;
-}
-
-.navleft {
-  margin-left: 1ex;
-  position: relative;
-  float: left;
-  white-space: nowrap;
-}
-.navright {
-  margin-right: 1ex;
-  position: relative;
-  float: right;
-  white-space: nowrap;
-}
-.nonavigation {
-  color: #e0e0e0;
-}
-
-.navleft .tocsettoggle {
-  display: none;
-}
-
-.searchform {
-  display: inline;
-  margin: 0;
-  padding: 0;
-}
-
-.nosearchform {
-  display: none;
-}
-
-.searchbox {
-  width: 16em;
-  margin: 0px;
-  padding: 0px;
-  background-color: #eee;
-  border: 1px solid #ddd;
-  vertical-align: middle;
-}
-
-.searchbox::placeholder {
-  text-align: center;
-}
-
-#contextindicator {
-  position: fixed;
-  background-color: #c6f;
-  color: #000;
-  font-family: monospace;
-  font-weight: bold;
-  padding: 2px 10px;
-  display: none;
-  right: 0;
-  bottom: 0;
-}
-
-/* ---------------------------------------- */
-/* Version */
-
-.versionbox {
-  position: relative;
-  float: right;
-  left: 2em;
-  height: 0em;
-  width: 13em;
-  margin: 0em -13em 0em 0em;
-}
-.version {
-  font-size: small;
-}
-.versionNoNav {
-  font-size: xx-small; /* avoid overlap with author */
-}
-
-.version:before, .versionNoNav:before {
-  content: "Version ";
-}
-
-/* ---------------------------------------- */
-/* Language Family */
-
-.navfamily {
-  float: right;
-  white-space: nowrap;
-  left: 2em;
-  height: 0em;
-  width: 10.5em;
-  margin: 1.5em -13em 0em 0em;
-  font-size: small;
-}
-
-.docfamily:after {
-  content: " language family";
-}
-
-/* ---------------------------------------- */
-/* Margin notes */
-
-.refpara, .refelem, .reffootnote {
-  position: relative;
-  float: right;
-  left: 2em;
-  height: 0em;
-  width: 13em;
-  margin: 0em -13em 0em 0em;
-}
-
-.refpara, .refparaleft, .reffootnote {
-  top: -1em;
-}
-
-.refcolumn {
-  background-color: #F5F5DC;
-  display: block;
-  position: relative;
-  width: 13em;
-  font-size: 85%;
-  border: 0.5em solid #F5F5DC;
-  margin: 0 0 0 0;
-  white-space: normal; /* in case margin note is inside code sample */
-}
-
-.refcontent {
-  margin: 0 0 0 0;
-}
-
-.refcontent p {
-  margin-top: 0;
-  margin-bottom: 0;
-}
-
-.refparaleft, .refelemleft {
-  position: relative;
-  float: left;
-  right: 2em;
-  height: 0em;
-  width: 13em;
-  margin: 0em 0em 0em -13em;
-}
-
-.refcolumnleft {
-  background-color: #F5F5DC;
-  display: block;
-  position: relative;
-  width: 13em;
-  font-size: 85%;
-  border: 0.5em solid #F5F5DC;
-  margin: 0 0 0 0;
-}
-
-/* narrow display => inline right-hand margin notes */
-@media screen and (max-width: 55em) {
-    .refpara, .refelem, .reffootnote {
-        all: unset !important;
-        display: block !important;
-        margin: 1em 0 !important;
-        padding: 0.75em !important;
-    }
-}
-
-/* ---------------------------------------- */
-/* Table of contents, inline */
-
-.toclink {
-  text-decoration: none;
-  color: blue;
-  font-size: 85%;
-}
-
-.toptoclink {
-  text-decoration: none;
-  color: blue;
-  font-weight: bold;
-}
-
-/* ---------------------------------------- */
-/* Table of contents, left margin */
-
-.tocset {
-  position: relative;
-  float: left;
-  width: 12.5em;
-  margin-right: 2em;
-}
-.tocset td {
-  vertical-align: text-top;
-}
-
-.tocview {
-  text-align: left;
-  background-color: #f0f0e0;
-}
-
-.tocsub {
-  text-align: left;
-  margin-top: 0.5em;
-  background-color: #f0f0e0;
-}
-
-.tocviewlist, .tocsublist {
-  margin-left: 0.2em;
-  margin-right: 0.2em;
-  padding-top: 0.2em;
-  padding-bottom: 0.2em;
-}
-.tocviewlist table {
-  font-size: 82%;
-}
-
-.tocviewlisttopspace {
-  margin-bottom: 1em;
-}
-
-.tocviewsublist, .tocviewsublistonly, .tocviewsublisttop, .tocviewsublistbottom {
-  margin-left: 0.4em;
-  border-left: 1px solid #bbf;
-  padding-left: 0.8em;
-}
-.tocviewsublist {
-  margin-bottom: 1em;
-}
-.tocviewsublist table,
-.tocviewsublistonly table,
-.tocviewsublisttop table,
-.tocviewsublistbottom table {
-  font-size: 75%;
-}
-
-.tocviewtitle * {
-  font-weight: bold;
-}
-
-.tocviewlink {
-  text-decoration: none;
-  color: blue;
-}
-
-.tocviewselflink {
-  text-decoration: underline;
-  color: blue;
-}
-
-.tocviewtoggle {
-  text-decoration: none;
-  color: blue;
-  font-size: 75%; /* looks better, and avoids bounce when toggling sub-sections due to font alignments */
-}
-
-.tocsublist td {
-  padding-left: 1em;
-  text-indent: -1em;
-}
-
-.tocsublinknumber {
-  font-size: 82%;
-}
-
-.tocsublink {
-  font-size: 82%;
-  text-decoration: none;
-}
-
-.tocsubseclink {
-  font-size: 82%;
-  text-decoration: none;
-}
-
-.tocsubnonseclink {
-  font-size: 82%;
-  text-decoration: none;
-  padding-left: 0.5em;
-}
-
-.tocsubtitle {
-  font-size: 82%;
-  font-style: italic;
-  margin: 0.2em;
-}
-
-/* ---------------------------------------- */
-/* Some inline styles */
-
-.indexlink {
-  text-decoration: none;
-}
-
-.nobreak {
-  white-space: nowrap;
-}
-
-pre { margin-left: 2em; }
-blockquote { margin-left: 2em; }
-
-ol          { list-style-type: decimal; }
-ol ol       { list-style-type: lower-alpha; }
-ol ol ol    { list-style-type: lower-roman; }
-ol ol ol ol { list-style-type: upper-alpha; }
-
-.SCodeFlow {
-  display: block;
-  margin-left: 1em;
-  margin-bottom: 0em;
-  margin-right: 1em;
-  margin-top: 0em;
-  white-space: nowrap;  
-}
-
-.SVInsetFlow {
-  display: block;
-  margin-left: 0em;
-  margin-bottom: 0em;
-  margin-right: 0em;
-  margin-top: 0em;
-}
-
-.SubFlow {
-  display: block;
-  margin: 0em;
-}
-
-.boxed {
-  width: 100%;
-  background-color: #E8E8FF;
-}
-
-.hspace {
-}
-
-.slant {
-  font-style: oblique;
-}
-
-.badlink {
-  text-decoration: underline;
-  color: red;
-}
-
-.plainlink {
-  text-decoration: none;
-  color: blue;
-}
-
-.techoutside       { text-decoration: underline; color: #b0b0b0; }
-.techoutside:hover { text-decoration: underline; color: blue; }
-
-/* .techinside:hover doesn't work with FF, .techinside:hover>
-   .techinside doesn't work with IE, so use both (and IE doesn't
-   work with inherit in the second one, so use blue directly) */
-.techinside                    { color: black; }
-.techinside:hover              { color: blue; }
-.techoutside:hover>.techinside { color: inherit; }
-
-.SCentered {
-  text-align: center;
-}
-
-.imageleft {
-  float: left;
-  margin-right: 0.3em;
-}
-
-.Smaller {
-  font-size: 82%;
-}
-
-.Larger {
-  font-size: 122%;
-}
-
-/* A hack, inserted to break some Scheme ids: */
-.mywbr {
-  display: inline-block;
-  height: 0;
-  width: 0;
-  font-size: 1px;
-}
-
-.compact li p {
-  margin: 0em;
-  padding: 0em;
-}
-
-.noborder img {
-  border: 0;
-}
-
-.SVerbatim {
-  white-space: nowrap;
-}
-
-.SAuthorListBox {
-  position: relative;
-  float: right;
-  left: 2em;
-  top: -2.25em;
-  height: 0em;
-  width: 13em;
-  margin: 0em -13em 0em 0em;
-}
-.SAuthorList {
-  font-size: 82%;
-}
-.SAuthorList:before {
-  content: "by ";
-}
-.author {
-  display: inline;
-  white-space: nowrap;
-}
-
-/* print styles : hide the navigation elements */
-@media print {
-  .tocset,
-  .navsettop,
-  .navsetbottom { display: none; }
-  .maincolumn {
-    width: auto;
-    margin-right: 13em;
-    margin-left: 0;
-  }
-}
-
-/** Begin headings */
-
-/* Hide the button group by default, but show them on hovering the heading title */
-.button-group {
-    padding-left: 0.3em;
-    visibility: hidden;
-    position: absolute;
-}
-.heading:hover > .button-group {
-    visibility: visible;
-}
-
-.button-group > a {
-    margin: 0 0.25em;
-}
-
-.button-group > a, .button-group > a:hover {
-    text-decoration: none;
-}
-
-.heading-anchor {
-    font-size: 60%;
-    /* A trick to color an emoji from https://stackoverflow.com/questions/32413731/color-for-unicode-emoji */
-    color: transparent;
-    text-shadow: 0 0 0 gray;
-    vertical-align: 5%;
-}
-
-.heading-source {
-    visibility: hidden;
-}

tests/basic.rkt

@@ -1,116 +0,0 @@
-#lang racket/base
-
-(require rackunit
-         racket/file
-         git)
-
-(define tmp (make-temporary-file "racket-git-test~a" 'directory))
-
-(dynamic-wind
-  void
-  (lambda ()
-    (make-directory (build-path tmp "sub"))
-    (parameterize ([current-directory tmp])
-      (git 'init)
-      (check-true (git-repository?))
-      (check-equal? (git-current-branch) "master")
-      (check-true (git-clean?))
-
-      (git 'config "user.name" "Racket Git Test")
-      (git 'config "user.email" "racket-git-test@example.invalid")
-      (check-equal? (git-config "user.name") "Racket Git Test")
-
-      (call-with-output-file ".gitignore"
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "ignored.txt" out)))
-      (call-with-output-file "ignored.txt"
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "ignored" out)))
-      (call-with-output-file (build-path "sub" "hello.txt")
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "hello" out)))
-
-      (check-equal? (git-status-lines)
-                    '("?? .gitignore" "?? sub/hello.txt"))
-
-      (define status-output (open-output-string))
-      (define displayed-status
-        (parameterize ([current-output-port status-output])
-          (dgit 'status)))
-      (check-equal? displayed-status (git 'status))
-      (check-equal? (get-output-string status-output)
-                    "New          - .gitignore\nNew          - sub/hello.txt\n")
-      (check-false (regexp-match? #rx"ignored[.]txt"
-                                  (get-output-string status-output)))
-
-      (parameterize ([current-directory (build-path tmp "sub")])
-        (git 'add "hello.txt"))
-      (check-equal? (git-status-lines)
-                    '("?? .gitignore" "A  sub/hello.txt"))
-
-      (git 'add ".gitignore")
-      (define first (git-commit "initial commit"))
-      (check-equal? (string-length first) 40)
-      (check-true (git-clean?))
-      (check-equal? (git 'diff) "")
-      (check-equal? (git 'diff '--cached) "")
-
-      (call-with-output-file (build-path "sub" "hello.txt")
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "changed" out)))
-      (define worktree-diff (git 'diff))
-      (check-true (regexp-match? #rx"-hello" worktree-diff))
-      (check-true (regexp-match? #rx"[+]changed" worktree-diff))
-      (check-equal? (git 'diff '--cached) "")
-
-      (define diff-output (open-output-string))
-      (parameterize ([current-output-port diff-output])
-        (dgit 'diff))
-      (check-equal? (get-output-string diff-output) worktree-diff)
-
-      (git 'add "sub/hello.txt")
-      (check-equal? (git 'diff) "")
-      (define cached-diff (git 'diff '--cached))
-      (check-true (regexp-match? #rx"-hello" cached-diff))
-      (check-true (regexp-match? #rx"[+]changed" cached-diff))
-      (git 'commit "prepare branches")
-
-      (git 'checkout '-b "work")
-      (call-with-output-file (build-path "sub" "hello.txt")
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "work" out)))
-      (git 'add)
-      (git 'commit "work change")
-      (check-equal? (file->string (build-path "sub" "hello.txt")) "work\n")
-
-      (git 'checkout "master")
-      (check-equal? (file->string (build-path "sub" "hello.txt")) "changed\n")
-      (check-equal? (git-current-branch) "master")
-      (check-not-false (member "work" (git 'branch)))
-
-      ;; Safe checkout must not overwrite an uncommitted tracked change.
-      (call-with-output-file (build-path "sub" "hello.txt")
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "dirty" out)))
-      (check-exn exn:fail? (lambda () (git 'checkout "work")))
-      (check-equal? (git-current-branch) "master")
-      (check-equal? (file->string (build-path "sub" "hello.txt")) "dirty\n")
-      (call-with-output-file (build-path "sub" "hello.txt")
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "changed" out)))
-
-      (git 'branch '-d "work")
-      (check-false (member "work" (git 'branch)))
-
-      (define tag-id (git 'tag "v0.1"))
-      (check-equal? (string-length tag-id) 40)
-      (check-equal? (git 'tag) '("v0.1"))
-      (git 'checkout "v0.1")
-      (check-false (git-current-branch))
-      (git 'checkout "master")
-      (git 'tag '-d "v0.1")
-      (check-equal? (git 'tag) '())
-
-      (check-equal? (length (git 'log 10)) 2)))
-  (lambda ()
-    (delete-directory/files tmp)))

tests/credentials.rkt

@@ -1,30 +0,0 @@
-#lang racket/base
-
-(require rackunit
-         "../credentials.rkt")
-
-;; Never touch the real racket-git preferences from the test suite.
-(parameterize ([current-git-credentials-store 'racket-git-test]
-               [current-git-credentials-unlock-store 'racket-git-test-unlock])
-  (with-handlers ([exn:fail? (lambda (_) (void))])
-    (git-credentials-lock!))
-
-  (with-handlers ([exn:fail? (lambda (_) (void))])
-    (git-credentials-init! "test-password" #:unlock-for 60))
-
-  (unless (git-credentials-unlocked?)
-    (git-credentials-unlock! "test-password" #:for 60))
-
-  (check-true (git-credentials-unlocked?))
-  (git-credentials-set! "https://credentials-test.invalid"
-                        "tester" "secret-token")
-  (check-equal?
-   (git-credentials-ref "https://credentials-test.invalid")
-   '("tester" . "secret-token"))
-  (check-equal?
-   (git-credentials-ref "https://credentials-test.invalid/a/b.git")
-   '("tester" . "secret-token"))
-  (git-credentials-remove! "https://credentials-test.invalid")
-  (check-false (git-credentials-ref "https://credentials-test.invalid"))
-  (git-credentials-lock!)
-  (check-false (git-credentials-unlocked?)))

tests/remote.rkt

@@ -1,127 +0,0 @@
-#lang racket/base
-
-(require rackunit
-         racket/file
-         git)
-
-(define tmp (make-temporary-file "racket-git-remote-test~a" 'directory))
-(define origin (build-path tmp "origin.git"))
-(define a (build-path tmp "a"))
-(define b (build-path tmp "b"))
-(define c (build-path tmp "c"))
-
-(define (configure!)
-  (git 'config "user.name" "Racket Git Test")
-  (git 'config "user.email" "racket-git-test@example.invalid"))
-
-(dynamic-wind
-  void
-  (lambda ()
-    (git-init origin #:bare? #t)
-    (make-directory a)
-
-    (parameterize ([current-directory a])
-      (git 'init)
-      (configure!)
-      (call-with-output-file "value.txt"
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "one" out)))
-      (git 'add "value.txt")
-      (git 'commit "one")
-      (git 'remote 'add "origin" (path->string origin))
-      (check-equal? (git 'remote) '("origin"))
-      (check-equal? (git 'remote 'get-url "origin") (path->string origin))
-      (define push-out (open-output-string))
-      (parameterize ([current-output-port push-out])
-        (git 'push))
-      ;; A successful push must remain safe when the returned credentials,
-      ;; callbacks and options become eligible for collection.
-      (collect-garbage)
-      (collect-garbage)
-      (collect-garbage)
-      (check-true (regexp-match? #rx"\\[git\\] push origin/master"
-                                 (get-output-string push-out)))
-      (define quiet-out (open-output-string))
-      (parameterize ([current-output-port quiet-out])
-        (git 'push #:quiet #t))
-      (check-equal? (get-output-string quiet-out) ""))
-
-    (git-clone (path->string origin) b)
-    (define clone-quiet-out (open-output-string))
-    (parameterize ([current-output-port clone-quiet-out])
-      (git-clone (path->string origin) c #:quiet #t))
-    (check-equal? (get-output-string clone-quiet-out) "")
-
-    (parameterize ([current-directory b])
-      (configure!)
-      (check-equal? (git-current-branch) "master")
-      (call-with-output-file "value.txt"
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "two" out)))
-      (git 'add "value.txt")
-      (git 'commit "two")
-      (git 'push)
-      (git 'tag "v2")
-      (git 'push-tag "v2")
-      (define push-tag-quiet-out (open-output-string))
-      (parameterize ([current-output-port push-tag-quiet-out])
-        (git 'push-tag "v2" #:quiet #t))
-      (check-equal? (get-output-string push-tag-quiet-out) ""))
-
-    (parameterize ([current-directory a])
-      (check-equal? (file->string "value.txt") "one\n")
-      (check-equal? (string-length (git 'pull)) 40)
-      (check-equal? (file->string "value.txt") "two\n")
-      (check-true (git-clean?))
-      (git 'fetch)
-      (check-equal? (git 'tag) '("v2"))
-      (define fetch-quiet-out (open-output-string))
-      (parameterize ([current-output-port fetch-quiet-out])
-        (git 'fetch #:quiet #t))
-      (check-equal? (get-output-string fetch-quiet-out) "")
-      (define pull-quiet-out (open-output-string))
-      (check-false
-       (parameterize ([current-output-port pull-quiet-out])
-         (git 'pull #:quiet #t)))
-      (check-equal? (get-output-string pull-quiet-out) "")
-
-      (call-with-output-file "local.txt"
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "local" out)))
-      (git 'add "local.txt")
-      (git 'commit "local change"))
-
-    (parameterize ([current-directory b])
-      (call-with-output-file "remote.txt"
-        #:exists 'truncate/replace
-        (lambda (out) (displayln "remote" out)))
-      (git 'add "remote.txt")
-      (git 'commit "remote change")
-      (git 'push))
-
-    (parameterize ([current-directory a])
-      (define before (git-head))
-      (check-exn #rx"non-fast-forward"
-                 (lambda () (git 'pull)))
-      (check-equal? (git-head) before)
-      (check-true (file-exists? "local.txt"))
-      (check-false (file-exists? "remote.txt"))))
-  (lambda ()
-    (delete-directory/files tmp)))
-
-;; HTTPS push without configured credentials must fail before entering libgit2.
-(let ([tmp2 (make-temporary-file "racket-git-https-test~a" 'directory)])
-  (dynamic-wind
-    void
-    (lambda ()
-      (parameterize ([current-directory tmp2])
-        (git 'init)
-        (configure!)
-        (call-with-output-file "x.txt" #:exists 'truncate/replace
-          (lambda (out) (displayln "x" out)))
-        (git 'add "x.txt")
-        (git 'commit "x")
-        (git 'remote 'add "origin" "https://example.invalid/private/repo.git")
-        (check-exn #rx"no HTTPS credentials are stored"
-                   (lambda () (git 'push)))))
-    (lambda () (delete-directory/files tmp2))))

tests/stress-commit.rkt

@@ -1,18 +0,0 @@
-#lang racket/base
-(require racket/file rackunit git)
-(define tmp (make-temporary-file "racket-git-stress~a" 'directory))
-(dynamic-wind
- void
- (lambda ()
-   (parameterize ([current-directory tmp])
-     (git 'init)
-     (git 'config "user.name" "Stress Test")
-     (git 'config "user.email" "stress@example.invalid")
-     (for ([i (in-range 50)])
-       (call-with-output-file "counter.txt" #:exists 'truncate/replace
-         (lambda (out) (fprintf out "~a\n" i)))
-       (git 'add "counter.txt")
-       (define oid (git 'commit (format "commit ~a" i)))
-       (check-equal? (string-length oid) 40))
-     (check-equal? (length (git 'log 100)) 50)))
- (lambda () (delete-directory/files tmp)))