Compare commits

8 Commits

9 changed files with 1081 additions and 261 deletions
+46 -39
View File
@@ -1,51 +1,58 @@
#lang racket #lang racket/base
(require racket-makefile (require racket-makefile
package-zipper package-zipper
net/sendurl 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-target "docs/git.html")
(define doc-src "scribblings/git.scrbl") (define doc-src "scribblings/git.scrbl")
(target doc-target (makefile git-cli
(deps doc-src)
(unless (directory-exists? "docs") (target all
(make-directory "docs")) (displayln "use (make clean) or (make package)")
(raco '(scribble --html +m --dest "docs" $<))) )
(target doc (target clean
(deps doc-target) (for-each (λ (f) (displayln f) (rm-f f)) (list-files "." #px"([.]bak|~)$" #:recursive #t))
(displayln "Documentation built") (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 showdoc (target version
(deps doc) (displayln
(send-url/file doc-target)) (git 'next-version)))
(target refresh (target package
(displayln "Refreshing makefile") (deps clean)
(refresh-makefile) (zip-package))
(displayln "done.")
) (target zip
(target setup (deps package))
(raco '(setup git)))
(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)))
)
+104 -17
View File
@@ -7,6 +7,7 @@ procedure and through direct procedures.
```racket ```racket
(require git-cli) (require git-cli)
(git 'init)
(git 'status) (git 'status)
(git 'log '-l '-5) (git 'log '-l '-5)
(git 'fetch '--prune) (git 'fetch '--prune)
@@ -22,15 +23,40 @@ procedure and through direct procedures.
``` ```
`git` is an ordinary procedure. The first argument is the Git command symbol `git` is an ordinary procedure. The first argument is the Git command symbol
and the remaining arguments are passed to that command. 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.
For example, commands that do not have a dedicated wrapper can still be used:
```racket
(git 'blame "main.rkt")
(git* clean -n)
(git* worktree list)
(git* archive --format=zip HEAD)
```
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 `git*` is the compact command-style syntax. Bare arguments are converted to
strings, so `(git* remote get-url origin)` is equivalent to strings, so `(git* remote get-url origin)` is equivalent to
`(git 'remote "get-url" "origin")`. Use `(eval expression)` when an argument `(git 'remote "get-url" "origin")`. A bare identifier is therefore command-line
must come from a Racket expression. `gt` remains available as a compatibility text, not the value of a Racket variable or procedure with the same name. Use
alias for `git*`. `(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 ```racket
(git* init)
(git* remote -v) (git* remote -v)
(git* switch main) (git* switch main)
(git* restore --staged main.rkt) (git* restore --staged main.rkt)
@@ -65,14 +91,22 @@ behavior:
Git is searched on `PATH`. Git itself remains responsible for remotes, Git is searched on `PATH`. Git itself remains responsible for remotes,
credentials, SSH keys, pull strategy, and other repository configuration. credentials, SSH keys, pull strategy, and other repository configuration.
## Rash integration
Rash integration is provided by the separate `rash-git-cli` package. The `git-cli` package itself has no dependency on Rash or Linea.
## Commands ## Commands
The package currently registers commands including `status`, `add`, `commit`, The package registers wrappers for commands where git-cli adds useful behavior,
`push`, `pull`, `fetch`, `config`, `branch`, `remote`, `stash`, `restore`, `reset`, `revert`, `rebase`, `merge`, `cherry-pick`, `mergetool`, `switch`, `clone`, `tag`, `log`, including `init`, `status`, `add`, `commit`, `push`, `pull`, `fetch`, `config`,
`rev-list`, `diff`, `show`, `grep`, `help`, `version`, and `new-version`. `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 are also exported as direct procedures such as `git-status`, `git-add`, Most registered commands are also exported as direct procedures such as
`git-fetch`, `git-config`, `git-switch`, `git-tag`, `git-log`, `git-diff`, and `git-show`. `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. See the Scribble documentation for command-specific behavior and return values.
@@ -96,6 +130,55 @@ See the Scribble documentation for command-specific behavior and return values.
returns all values for one key. `get key` returns one string or `#f` when the 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. 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* config editor)
```
The non-interactive forms are:
```racket
(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")
```
`--list` returns `(name description command current?)` items and `--downloads`
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* config mergetool)
(git* config mergetool --list)
(git* config mergetool --downloads)
(git* config mergetool winmerge)
(git* config mergetool auto)
```
`--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.
## Low-level Git execution ## Low-level Git execution
`run-git` can be used when direct access to Git's stdin/stdout protocol is `run-git` can be used when direct access to Git's stdin/stdout protocol is
@@ -137,20 +220,23 @@ A custom handler can still be installed through
## GUI editor and merge tool ## GUI editor and merge tool
git-cli looks for a GUI editor and passes it to Git through `GIT_EDITOR` and When git-cli is loaded, it configures the current Racket process once for the
`GIT_SEQUENCE_EDITOR` in the environment of the Git subprocess only. It does Git commands it starts. `GIT_TERMINAL_PROMPT` is set to `0`. When a GUI editor
not change the user's global Git configuration. 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: The editor can be inspected or configured explicitly:
```racket ```racket
(find-editor) (find-editor)
(find-editors)
(set-editor! "code --wait") (set-editor! "code --wait")
(set-editor-auto!)
``` ```
The editor search first checks `PATH` and then well-known platform locations. 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 On Windows this includes the normal per-user and Program Files locations for
VS Code, with Notepad as fallback. On macOS the standard Visual Studio Code 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`, application bundle and TextEdit are recognized. On Linux common `/usr`,
`/usr/local`, and Snap locations are checked for VS Code, Kate, Gedit, and Xed. `/usr/local`, and Snap locations are checked for VS Code, Kate, Gedit, and Xed.
@@ -158,15 +244,16 @@ application bundle and TextEdit are recognized. On Linux common `/usr`,
specified explicitly, git-cli prefers a configured or well-known graphical specified explicitly, git-cli prefers a configured or well-known graphical
tool such as WinMerge, Meld, KDiff3, VS Code, TortoiseMerge, or opendiff. tool such as WinMerge, Meld, KDiff3, VS Code, TortoiseMerge, or opendiff.
The finder checks `PATH` first and then common platform installation locations. The finder checks `PATH` first and then common platform installation locations.
When a merge tool is found outside `PATH`, git-cli adds that executable's `find-mergetool-path` can be used to inspect the executable that was found.
directory to the environment of the Git subprocess, so Git's own mergetool If no tool is found, Git is left to select its own default.
integration can still find it. If no tool is found, Git is left to select its
own default.
```racket ```racket
(find-mergetool) (find-mergetool)
(find-mergetools)
(find-mergetool-path) (find-mergetool-path)
(mergetool-downloads)
(set-mergetool! "winmerge") (set-mergetool! "winmerge")
(set-mergetool-auto!)
(git* mergetool) (git* mergetool)
(git* mergetool --tool=meld) (git* mergetool --tool=meld)
``` ```
+4 -3
View File
@@ -2,7 +2,7 @@
(define collection "git-cli") (define collection "git-cli")
(define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command") (define pkg-desc "Command-line-like Git operations for Racket, interface to the git cli command")
(define version "0.3.36") (define version "0.4.7")
(define pkg-authors '("Hans Dijkema")) (define pkg-authors '("Hans Dijkema"))
(define license 'MIT) (define license 'MIT)
@@ -13,11 +13,12 @@
"racket-index" "racket-index"
"scribble-lib" "scribble-lib"
"net-lib" "net-lib"
)) ))
(define build-deps (define build-deps
'("rackunit-lib" '("rackunit-lib"
"racket-doc")) "racket-doc"
))
(define scribblings (define scribblings
'(("scribblings/git-cli.scrbl" () ("git-cli")))) '(("scribblings/git-cli.scrbl" () ("git-cli"))))
+372 -11
View File
@@ -10,12 +10,14 @@
"private/find-mergetool.rkt" "private/find-mergetool.rkt"
simple-log simple-log
racket/string racket/string
racket/list
net/sendurl net/sendurl
) )
(provide gt (provide gt
git* git*
git git
git-init
git-add git-add
git-status git-status
git-commit git-commit
@@ -46,10 +48,16 @@
git-new-version git-new-version
git-next-version git-next-version
find-editor find-editor
find-editors
editor-downloads
set-editor! set-editor!
set-editor-auto!
find-mergetool find-mergetool
find-mergetools
find-mergetool-path find-mergetool-path
mergetool-downloads
set-mergetool! set-mergetool!
set-mergetool-auto!
default-git-authentication-handler default-git-authentication-handler
current-git-authentication-handler current-git-authentication-handler
exn:fail:git-auth? exn:fail:git-auth?
@@ -88,17 +96,26 @@
(git* cmd arg ...)))) (git* cmd arg ...))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Invoke a supported Git command through the command table. ; goal : Invoke a Git command through a registered wrapper or direct fallback.
; pre : command is a registered Git command symbol. ; pre : command identifies a Git command and args contains its arguments.
; post : The selected command has processed all supplied arguments. ; post : Registered commands use their wrapper; other commands are passed to Git.
; result : The command-specific result. ; result : The command-specific result or the standard Git command result.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git command . args) (define (git command . args)
((hash-ref git-commands command (let ((cmd (hash-ref git-commands command #f)))
(λ () (if cmd
(error "Not a supported or recognized git command: " command))) (cmd args)
args)) (let-values (((exit-code output)
(run-git (cons command (flatten args)))))
(let-values (((result out) (git-out command output)))
(std-process-git-result
command
exit-code
result
output
out
(make-hash)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions ;; Supporting functions
@@ -197,6 +214,326 @@
; pre : args starts with get or set! and follows one of the supported forms. ; pre : args starts with get or set! and follows one of the supported forms.
; post : info contains the config operation used to process Git's result. ; post : info contains the config operation used to process Git's result.
; result : Arguments accepted by git config. ; result : Arguments accepted by git config.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return the editor description matching a configured editor name.
; pre : name can be formatted as an editor name.
; post : The editor list has only been inspected.
; result : A (name description command) item, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-editor-by-name name)
(let ((name* (string-downcase (format "~a" name))))
(let loop ((editors (find-editors)))
(cond
((null? editors) #f)
((string=? (string-downcase (car (car editors))) name*)
(car editors))
(else
(loop (cdr editors)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return a Racket-oriented list of available GUI editors.
; pre : The platform editor finder is available.
; post : No editor has been started.
; result : (name description command current?) items.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (available-editors)
(let ((current (find-editor)))
(map
(λ (editor)
(list (car editor)
(cadr editor)
(caddr editor)
(and current
(string=? current (caddr editor)))))
(find-editors))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Display the interactive git-cli editor selection.
; pre : editors contains the discovered editor descriptions.
; post : The choices have been displayed.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (display-editor-selection editors)
(displayln "Available editors:")
(newline)
(let loop ((items editors)
(index 1))
(unless (null? items)
(let* ((editor (car items))
(current (find-editor))
(current? (and current
(string=? current (caddr editor)))))
(displayln
(format " ~a. ~a~a"
index
(cadr editor)
(if current? " [current]" "")))
(displayln (format " ~a" (caddr editor)))
(newline)
(loop (cdr items) (+ index 1)))))
(displayln (format " ~a. Specify another editor command"
(+ (length editors) 1)))
(displayln (format " ~a. Automatic detection"
(+ (length editors) 2)))
(displayln (format " ~a. Download/install suggestions"
(+ (length editors) 3)))
(displayln " 0. Cancel")
(newline))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Ask the user to choose or enter the editor used by git-cli.
; pre : Standard input and output are available.
; post : A selected editor has been stored and activated, or the operation was cancelled.
; result : The selected editor command, or #f after cancellation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (configure-editor-interactively)
(let ((editors (find-editors)))
(display-editor-selection editors)
(let* ((custom-index (+ (length editors) 1))
(auto-index (+ (length editors) 2))
(downloads-index (+ (length editors) 3))
(choice
(input-prompt
"Editor: "
#:loop-until
(λ (value)
(cond
((eof-object? value) 'cancel)
(else
(let ((n (string->number value)))
(if (and n
(integer? n)
(<= 0 n downloads-index))
n
#f))))))))
(cond
((eq? choice 'cancel) #f)
((= choice 0) #f)
((<= choice (length editors))
(set-editor! (caddr (list-ref editors (- choice 1)))))
((= choice custom-index)
(let ((command
(input-prompt
"Editor command: "
#:loop-until
(λ (value)
(cond
((eof-object? value) 'cancel)
((string=? (string-trim value) "") #f)
(else value))))))
(if (eq? command 'cancel)
#f
(set-editor! command))))
((= choice auto-index)
(set-editor-auto!))
((= choice downloads-index)
(display-download-pointers
"Suggested editors:"
(editor-downloads)))
(else #f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Process the git-cli-specific `config editor` command.
; pre : args contains the arguments following `editor`.
; post : The requested editor configuration action has been performed.
; result : Editor data, the selected command, or #f after cancellation.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-config-editor args)
(cond
((null? args)
(configure-editor-interactively))
((and (= (length args) 1)
(git-argument=? (car args) '--list))
(available-editors))
((and (= (length args) 1)
(git-argument=? (car args) '--downloads))
(editor-downloads))
((and (= (length args) 1)
(git-argument=? (car args) 'auto))
(set-editor-auto!))
((= (length args) 1)
(let ((editor (find-editor-by-name (car args))))
(if editor
(set-editor! (caddr editor))
(set-editor! (format "~a" (car args))))))
(else
(error 'git-config "Expected config editor [--list|--downloads|auto|editor-name|editor-command]"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Display official download pointers.
; pre : items contains (name description url) items.
; post : The pointers have been displayed.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (display-download-pointers title items)
(displayln title)
(newline)
(for-each
(λ (item)
(displayln (format " ~a" (cadr item)))
(displayln (format " ~a" (caddr item)))
(newline))
items)
(void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return the merge tool description matching a configured tool name.
; pre : name can be formatted as a merge tool name.
; post : The merge tool list has only been inspected.
; result : A (name description path) item, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-mergetool-by-name name)
(let ((name* (string-downcase (format "~a" name))))
(let loop ((tools (find-mergetools)))
(cond
((null? tools) #f)
((string=? (string-downcase (car (car tools))) name*)
(car tools))
(else
(loop (cdr tools)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return a Racket-oriented list of available merge tools.
; pre : The platform merge tool finder is available.
; post : No merge tool has been started.
; result : (name description path current?) items.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (available-mergetools)
(let ((current (find-mergetool)))
(map
(λ (tool)
(list (car tool)
(cadr tool)
(caddr tool)
(and current
(string=? current (car tool)))))
(find-mergetools))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Display the interactive git-cli merge tool selection.
; pre : tools contains the discovered merge tool descriptions.
; post : The choices have been displayed.
; result : void.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (display-mergetool-selection tools)
(displayln "Available merge tools:")
(newline)
(let loop ((items tools)
(index 1))
(unless (null? items)
(let* ((tool (car items))
(current (find-mergetool))
(current? (and current
(string=? current (car tool)))))
(displayln
(format " ~a. ~a~a"
index
(cadr tool)
(if current? " [current]" "")))
(displayln (format " ~a" (caddr tool)))
(newline)
(loop (cdr items) (+ index 1)))))
(displayln (format " ~a. Specify another merge tool name"
(+ (length tools) 1)))
(displayln (format " ~a. Automatic detection"
(+ (length tools) 2)))
(displayln (format " ~a. Download/install suggestions"
(+ (length tools) 3)))
(displayln " 0. Cancel")
(newline))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Ask the user to choose or enter the merge tool used by git-cli.
; pre : Standard input and output are available.
; post : A selected merge tool has been stored, automatic detection was restored,
; download pointers were shown, or the operation was cancelled.
; result : The selected merge tool name, #f after cancellation, or void after pointers.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (configure-mergetool-interactively)
(let ((tools (find-mergetools)))
(display-mergetool-selection tools)
(let* ((custom-index (+ (length tools) 1))
(auto-index (+ (length tools) 2))
(downloads-index (+ (length tools) 3))
(choice
(input-prompt
"Merge tool: "
#:loop-until
(λ (value)
(cond
((eof-object? value) 'cancel)
(else
(let ((n (string->number value)))
(if (and n
(integer? n)
(<= 0 n downloads-index))
n
#f))))))))
(cond
((eq? choice 'cancel) #f)
((= choice 0) #f)
((<= choice (length tools))
(set-mergetool! (car (list-ref tools (- choice 1)))))
((= choice custom-index)
(let ((tool
(input-prompt
"Merge tool name: "
#:loop-until
(λ (value)
(cond
((eof-object? value) 'cancel)
((string=? (string-trim value) "") #f)
(else value))))))
(if (eq? tool 'cancel)
#f
(set-mergetool! tool))))
((= choice auto-index)
(set-mergetool-auto!))
((= choice downloads-index)
(display-download-pointers
"Suggested merge tools:"
(mergetool-downloads)))
(else #f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Process the git-cli-specific `config mergetool` command.
; pre : args contains the arguments following `mergetool`.
; post : The requested merge tool configuration action has been performed.
; result : Merge tool data, the selected tool name, download pointers, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-config-mergetool args)
(cond
((null? args)
(configure-mergetool-interactively))
((and (= (length args) 1)
(git-argument=? (car args) '--list))
(available-mergetools))
((and (= (length args) 1)
(git-argument=? (car args) '--downloads))
(mergetool-downloads))
((and (= (length args) 1)
(git-argument=? (car args) 'auto))
(set-mergetool-auto!))
((= (length args) 1)
(let ((tool (find-mergetool-by-name (car args))))
(if tool
(set-mergetool! (car tool))
(set-mergetool! (format "~a" (car args))))))
(else
(error 'git-config
"Expected config mergetool [--list|--downloads|auto|tool-name]"))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-config-args args info) (define (git-config-args args info)
(define (scope? x) (define (scope? x)
@@ -362,6 +699,14 @@
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Create an empty Git repository or reinitialize an existing repository.
; pre : The supplied arguments are valid for git init.
; post : Git init has completed successfully or an exception was raised.
; result : #t after a successful initialization.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-init cmd-git-init 'init)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Add file contents to the Git index. ; goal : Add file contents to the Git index.
; pre : The supplied arguments are valid for git add. ; pre : The supplied arguments are valid for git add.
@@ -424,10 +769,26 @@
; post : Git config has completed or an exception has been raised. ; post : Git config has completed or an exception has been raised.
; result : Structured config data, #f for a missing key, or #t after set!. ; result : Structured config data, #f for a missing key, or #t after set!.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(def-cmd git-config cmd-git-config 'config (def-git-cmd-proxy cmd-git-config-git 'config
git-config-args git-config-args
process-git-config-result) process-git-config-result)
(define (cmd-git-config args)
(cond
((and (pair? args)
(git-argument=? (car args) 'editor))
(git-config-editor (cdr args)))
((and (pair? args)
(git-argument=? (car args) 'mergetool))
(git-config-mergetool (cdr args)))
(else
(cmd-git-config-git args))))
(define (git-config . args)
(cmd-git-config args))
(hash-set! git-commands 'config cmd-git-config)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : List, create or delete branches. ; goal : List, create or delete branches.
@@ -990,7 +1351,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Increment the package version in info.rkt. ; goal : Increment the package version in info.rkt.
; pre : kind is 'maj, 'major, 'min, 'minor or 'patch. ; pre : kind represents maj, major, min, minor or patch as symbol or text.
; post : The version definition in info.rkt has been updated. ; post : The version definition in info.rkt has been updated.
; result : The new version as a list containing major, minor and patch. ; result : The new version as a list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -999,7 +1360,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Implement the registered new-version command. ; goal : Implement the registered new-version command.
; pre : args contains a supported version kind. ; pre : args contains a supported version kind as symbol or text.
; post : The version definition in info.rkt has been updated. ; post : The version definition in info.rkt has been updated.
; result : The new version as a list containing major, minor and patch. ; result : The new version as a list containing major, minor and patch.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+191 -95
View File
@@ -1,11 +1,15 @@
#lang racket/base #lang racket/base
(require racket/path (require racket/path
racket/string
"config.rkt") "config.rkt")
(provide find-editor (provide find-editor
find-editors
editor-downloads
configured-editor configured-editor
set-editor!) set-editor!
set-editor-auto!)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions ;; Supporting functions
@@ -20,21 +24,6 @@
(define (quote-command-path p) (define (quote-command-path p)
(format "\"~a\"" (path->string p))) (format "\"~a\"" (path->string p)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Return an existing executable from a list of candidate paths.
; pre : candidates contains paths or #f values.
; post : The filesystem has only been inspected.
; result : The first existing path, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (first-existing candidates)
(cond
((null? candidates) #f)
((and (car candidates)
(file-exists? (car candidates)))
(car candidates))
(else
(first-existing (cdr candidates)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Build a path below an environment variable when it is defined. ; goal : Build a path below an environment variable when it is defined.
; pre : variable is an environment variable name. ; pre : variable is an environment variable name.
@@ -48,102 +37,191 @@
#f))) #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Find an editor executable on PATH and append its wait arguments. ; 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. ; pre : executable is a pathless executable name.
; post : PATH has only been inspected. ; post : PATH has only been inspected.
; result : An editor command string, or #f. ; result : (name description command), or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (editor-on-path executable arguments) (define (editor-on-path name description executable arguments)
(let ((p (find-executable-path executable))) (let ((p (find-executable-path executable)))
(if p (editor-at name description p arguments)))
(string-append (quote-command-path p) arguments)
#f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Make an editor command from an existing well-known path. ; goal : Remove duplicate editor descriptions while preserving preference order.
; pre : p is a path or #f; arguments contains the editor wait arguments. ; pre : editors contains editor descriptions or #f values.
; post : p has only been inspected. ; post : editors has only been inspected.
; result : An editor command string, or #f. ; result : One editor description per editor name.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (editor-at p arguments) (define (unique-editors editors)
(if (and p (file-exists? p)) (let loop ((remaining editors)
(string-append (quote-command-path p) arguments) (names '())
#f)) (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 : Find a well-known GUI editor on Windows. ; goal : Return known GUI editors found on Windows.
; pre : The current platform is Windows. ; pre : The current platform is Windows.
; post : PATH and standard Windows installation locations were inspected. ; post : PATH and standard Windows installation locations were inspected.
; result : A Git editor command string, or #f. ; result : A list of editor descriptions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-windows-editor) (define (find-windows-editors)
(or (editor-on-path "code.cmd" " --wait") (unique-editors
(editor-on-path "code.exe" " --wait") (list
(editor-at (editor-on-path "vscode" "Visual Studio Code" "code.cmd" " --wait")
(first-existing (editor-on-path "vscode" "Visual Studio Code" "code.exe" " --wait")
(list (editor-at
(environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd") "vscode"
(environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd") "Visual Studio Code"
(environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd"))) (environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "bin" "code.cmd")
" --wait") " --wait")
(editor-at (editor-at
(first-existing "vscode"
(list "Visual Studio Code"
(environment-path "LOCALAPPDATA" "Programs" "Microsoft VS Code" "Code.exe") (environment-path "ProgramFiles" "Microsoft VS Code" "bin" "code.cmd")
(environment-path "ProgramFiles" "Microsoft VS Code" "Code.exe") " --wait")
(environment-path "ProgramFiles(x86)" "Microsoft VS Code" "Code.exe"))) (editor-at
" --wait") "vscode"
(editor-on-path "notepad.exe" "") "Visual Studio Code"
(editor-at (environment-path "ProgramFiles(x86)" "Microsoft VS Code" "bin" "code.cmd")
(environment-path "SystemRoot" "System32" "notepad.exe") " --wait")
"") (editor-on-path "notepad++"
#f)) "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 : Find a well-known GUI editor on macOS. ; goal : Return known GUI editors found on macOS.
; pre : The current platform is macOS. ; pre : The current platform is macOS.
; post : PATH and standard application locations were inspected. ; post : PATH and standard application locations were inspected.
; result : A Git editor command string, or #f. ; result : A list of editor descriptions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-macos-editor) (define (find-macos-editors)
(or (editor-on-path "code" " --wait") (unique-editors
(editor-at (list
(string->path (editor-on-path "vscode" "Visual Studio Code" "code" " --wait")
"/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code") (editor-at
" --wait") "vscode"
(let ((open "Visual Studio Code"
(or (find-executable-path "open") (string->path
(let ((p (string->path "/usr/bin/open"))) "/Applications/Visual Studio Code.app/Contents/Resources/app/bin/code")
(if (file-exists? p) p #f))))) " --wait")
(if open (let ((open
(format "~a -W -a TextEdit" (quote-command-path open)) (or (find-executable-path "open")
#f)) (let ((p (string->path "/usr/bin/open")))
#f)) (if (file-exists? p) p #f)))))
(if open
(list "textedit"
"TextEdit"
(format "~a -W -a TextEdit" (quote-command-path open)))
#f)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Find a well-known GUI editor on Unix/Linux. ; goal : Return known GUI editors found on Unix/Linux.
; pre : The current platform is Unix. ; pre : The current platform is Unix.
; post : PATH and common Linux installation locations were inspected. ; post : PATH and common Linux installation locations were inspected.
; result : A Git editor command string, or #f. ; result : A list of editor descriptions.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-unix-editor) (define (find-unix-editors)
(or (editor-on-path "code" " --wait") (unique-editors
(editor-on-path "kate" " --block") (list
(editor-on-path "gedit" " --wait") (editor-on-path "vscode" "Visual Studio Code" "code" " --wait")
(editor-on-path "xed" " --wait") (editor-on-path "kate" "Kate" "kate" " --block")
(editor-at (string->path "/snap/bin/code") " --wait") (editor-on-path "gedit" "Gedit" "gedit" " --wait")
(editor-at (string->path "/usr/local/bin/code") " --wait") (editor-on-path "xed" "Xed" "xed" " --wait")
(editor-at (string->path "/usr/bin/code") " --wait") (editor-at "vscode" "Visual Studio Code" (string->path "/snap/bin/code") " --wait")
(editor-at (string->path "/usr/local/bin/kate") " --block") (editor-at "vscode" "Visual Studio Code" (string->path "/usr/local/bin/code") " --wait")
(editor-at (string->path "/usr/bin/kate") " --block") (editor-at "vscode" "Visual Studio Code" (string->path "/usr/bin/code") " --wait")
(editor-at (string->path "/usr/bin/gedit") " --wait") (editor-at "kate" "Kate" (string->path "/usr/local/bin/kate") " --block")
(editor-at (string->path "/usr/bin/xed") " --wait") (editor-at "kate" "Kate" (string->path "/usr/bin/kate") " --block")
#f)) (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 ;; 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. ; goal : Read the editor explicitly configured for git-cli.
; pre : The git-cli configuration is readable. ; pre : The git-cli configuration is readable.
@@ -151,16 +229,35 @@
; result : The configured editor command, or #f. ; result : The configured editor command, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (configured-editor) (define (configured-editor)
(cfg-get 'git 'editor #f)) (let ((editor (cfg-get 'git 'editor #f)))
(if (and (string? editor)
(not (string=? (string-trim editor) "")))
editor
#f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Store the editor command used by git-cli. ; goal : Store and activate the editor command used by git-cli.
; pre : command is a command string suitable for GIT_EDITOR. ; pre : command is a command string suitable for GIT_EDITOR.
; post : The command has been stored in the git-cli configuration. ; post : The command has been stored and applied to the Git editor environment.
; result : The result returned by the configuration layer. ; result : command.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (set-editor! command) (define (set-editor! command)
(cfg-set! 'git '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. ; goal : Find the GUI editor that git-cli should offer to Git.
@@ -170,8 +267,7 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-editor) (define (find-editor)
(or (configured-editor) (or (configured-editor)
(case (system-type 'os) (let ((editors (find-editors)))
((windows) (find-windows-editor)) (if (null? editors)
((macosx) (find-macos-editor)) #f
((unix) (find-unix-editor)) (caddr (car editors))))))
(else #f))))
+114 -9
View File
@@ -4,9 +4,12 @@
"config.rkt") "config.rkt")
(provide find-mergetool (provide find-mergetool
find-mergetools
find-mergetool-path find-mergetool-path
mergetool-downloads
configured-mergetool configured-mergetool
set-mergetool!) set-mergetool!
set-mergetool-auto!)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions ;; Supporting functions
@@ -62,6 +65,56 @@
candidate candidate
(find-candidates (cdr candidates))))))) (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. ; goal : Return well-known graphical merge tool candidates for Windows.
; pre : Windows environment variables may or may not be defined. ; pre : Windows environment variables may or may not be defined.
@@ -159,9 +212,44 @@
; pre : The git-cli configuration is readable. ; pre : The git-cli configuration is readable.
; post : The configuration has not been changed. ; post : The configuration has not been changed.
; result : The configured Git merge tool name, or #f. ; 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) (define (configured-mergetool)
(cfg-get 'git 'mergetool #f)) (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. ; goal : Store the Git merge tool name used by git-cli.
@@ -172,6 +260,20 @@
(define (set-mergetool! tool) (define (set-mergetool! tool)
(cfg-set! 'git '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. ; goal : Find the graphical merge tool that git-cli should prefer.
; pre : The platform and git-cli configuration are available. ; pre : The platform and git-cli configuration are available.
@@ -192,10 +294,13 @@
; result : The executable path, or #f. ; result : The executable path, or #f.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (find-mergetool-path) (define (find-mergetool-path)
(let ((configured (configured-mergetool)) (let ((tool (find-mergetool)))
(detected (detected-mergetool))) (if tool
(if configured (let loop ((tools (find-mergetools)))
#f (cond
(if detected ((null? tools) #f)
(cadr detected) ((string=? tool (car (car tools)))
#f)))) (caddr (car tools)))
(else
(loop (cdr tools)))))
#f)))
+61 -67
View File
@@ -6,7 +6,6 @@
racket/system racket/system
"config.rkt" "config.rkt"
"find-editor.rkt" "find-editor.rkt"
"find-mergetool.rkt"
) )
(provide git-exe (provide git-exe
@@ -96,75 +95,70 @@
; read completely. ; read completely.
; result : The exit code and ordered (source line) output items. ; result : The exit code and ordered (source line) output items.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (run-git args #:input (input #f)) ; goal : Configure the process environment used by git-cli Git commands.
(let* ((env (environment-variables-copy ; pre : The editor finder can inspect the current platform.
(current-environment-variables))) ; post : Terminal prompting is disabled and a detected GUI editor is made
(editor (find-editor)) ; available to Git and Git's sequence editor.
(mergetool-path (find-mergetool-path))) ; result : void.
(environment-variables-set! env ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#"GIT_TERMINAL_PROMPT" (define (setup-git-environment!)
#"0") (putenv "GIT_TERMINAL_PROMPT" "0")
(let ((editor (find-editor)))
(when editor (when editor
(let ((editor-bytes (string->bytes/utf-8 editor))) (putenv "GIT_EDITOR" editor)
(environment-variables-set! env (putenv "GIT_SEQUENCE_EDITOR" editor)))
#"GIT_EDITOR" (void))
editor-bytes)
(environment-variables-set! env
#"GIT_SEQUENCE_EDITOR"
editor-bytes)))
(when mergetool-path
(let* ((directory (path-only mergetool-path))
(old-path (environment-variables-ref env #"PATH"))
(separator (if (eq? (system-type 'os) 'windows) ";" ":"))
(new-path
(if old-path
(string-append (path->string directory)
separator
(bytes->string/utf-8 old-path))
(path->string directory))))
(environment-variables-set! env
#"PATH"
(string->bytes/utf-8 new-path))))
(parameterize ((current-environment-variables env))
(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) (setup-git-environment!)
(read-output 'stderr stderr)
(let loop ((open-ports 2) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(result '())) ; goal : Run Git without allowing interactive terminal prompts.
(if (= open-ports 0) ; pre : args contains the Git command and its arguments; input is #f or a string
(begin ; that must be written to Git's standard input.
(subprocess-wait process) ; post : Optional input has been written and standard output and error have been
(values (subprocess-status process) ; read completely.
(reverse result))) ; result : The exit code and ordered (source line) output items.
(let* ((output (channel-get output-channel)) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(line (cadr output))) (define (run-git args #:input (input #f))
(if (eof-object? line) (let-values (((process stdout stdin stderr)
(loop (- open-ports 1) result) (apply subprocess
(loop open-ports #f
(cons output result))))))))))) #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 ;; Provided utility functions
+8 -7
View File
@@ -70,23 +70,24 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; goal : Increment a package version. ; goal : Increment a package version.
; pre : kind is maj, major, min, minor or patch. ; pre : kind represents maj, major, min, minor or patch as symbol or text.
; post : The version definition in info.rkt has been updated. ; post : The version definition in info.rkt has been updated.
; result : #t after writing the new version. ; result : #t after writing the new version.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (info-next-version kind . dir*) (define (info-next-version kind . dir*)
(let ((dir (if (null? dir*) (let ((dir (if (null? dir*)
"." "."
(car dir*)))) (car dir*)))
(if (memq kind '(maj major min minor patch)) (kind* (string->symbol (format "~a" kind))))
(if (memq kind* '(maj major min minor patch))
(let ((v (info-version dir))) (let ((v (info-version dir)))
(cond (cond
((or (eq? kind 'maj) ((or (eq? kind* 'maj)
(eq? kind 'major)) (eq? kind* 'major))
(apply set-info-version! (cons dir (apply set-info-version! (cons dir
(list (+ (car v) 1) 0 0)))) (list (+ (car v) 1) 0 0))))
((or (eq? kind 'min) ((or (eq? kind* 'min)
(eq? kind 'minor)) (eq? kind* 'minor))
(apply set-info-version! (cons dir (apply set-info-version! (cons dir
(list (car v) (+ (cadr v) 1) 0)))) (list (car v) (+ (cadr v) 1) 0))))
(else (else
+181 -13
View File
@@ -16,19 +16,39 @@ read credentials or other answers from the terminal.
@section{Command interface} @section{Command interface}
@defform[(git command argument ...)]{ @defform[(git command argument ...)]{
Runs a registered Git @racket[command]. The arguments are passed to the command. Runs a Git @racket[command]. When the command has a registered git-cli wrapper,
Registered command symbols are @racket['status], @racket['add], that wrapper is used. Registered wrappers can provide structured Racket results,
@racket['commit], @racket['push], @racket['pull], @racket['fetch], argument handling, or other command-specific behavior.
@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], Registered command symbols include @racket['init], @racket['status],
@racket['log], @racket['rev-list], @racket['diff], @racket['add], @racket['commit], @racket['push], @racket['pull],
@racket['show], @racket['grep], @racket['help], @racket['version], and @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]. @racket['new-version].
Most registered commands invoke the Git command with the same name. Some When no wrapper is registered, the command and arguments are passed directly to
commands process the result into a Racket value, such as @racket['status], the installed Git executable through @racket[run-git]. The result is handled by
@racket['grep], @racket['log] with @tt{--list}, @racket['version], and the same standard result processing used by ordinary pass-through wrappers:
@racket['new-version]. 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].
} }
@@ -49,11 +69,53 @@ converted from its literal syntax.
(git* switch (eval branch)) (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*]. @racket[gt] is retained as a compatibility alias for @racket[git*].
} }
@section{Rash integration}
Rash integration is provided by the separate @tt{rash-git-cli} package. The @racketmodname[git-cli] package itself does not depend on Rash or Linea.
@section{Provided commands} @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?]{ @defproc[(git-status [argument any/c] ...) list?]{
Runs @tt{git status --porcelain} with the supplied arguments. Runs @tt{git status --porcelain} with the supplied arguments.
@@ -155,6 +217,101 @@ appear directly after @racket['config] or directly after @racket['get] /
@racket['set!]. A successful write returns @racket[#t]. @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?)]{ @defproc[(git-branch [argument any/c] ...) (or/c boolean? list?)]{
Runs @tt{git branch} with the supplied arguments. This can be used to 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 create, rename, or delete branches according to the options supported by the
@@ -328,8 +485,9 @@ to choose its own default.
} }
@defproc[(find-editor) (or/c string? #f)]{ @defproc[(find-editor) (or/c string? #f)]{
Returns the configured or detected GUI editor command used for Returns the configured or detected GUI editor command. When git-cli is
@tt{GIT_EDITOR} and @tt{GIT_SEQUENCE_EDITOR}, without starting the editor. 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]{ @defproc[(set-editor! [command string?]) any/c]{
@@ -509,6 +667,16 @@ Updates the version in @filepath{info.rkt}. The kind is @racket['major],
abbreviations. The result is the new version as a list of three integers. 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} @section{Low-level Git execution}