Compare commits
8 Commits
cff2e7f558
...
main
| Author | SHA1 | Date | |
|---|---|---|---|
| 3c95a10ea5 | |||
| 2274dda72c | |||
| 6834b3d2ac | |||
| d2e2298731 | |||
| 175343e0ed | |||
| 0f7d780db1 | |||
| 03c874d0c4 | |||
| c18c10c22f |
@@ -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")
|
|
||||||
(make-directory "docs"))
|
|
||||||
(raco '(scribble --html +m --dest "docs" $<)))
|
|
||||||
|
|
||||||
(target doc
|
(target all
|
||||||
(deps doc-target)
|
(displayln "use (make clean) or (make package)")
|
||||||
(displayln "Documentation built")
|
)
|
||||||
)
|
|
||||||
|
|
||||||
(target showdoc
|
(target clean
|
||||||
(deps doc)
|
(for-each (λ (f) (displayln f) (rm-f f)) (list-files "." #px"([.]bak|~)$" #:recursive #t))
|
||||||
(send-url/file doc-target))
|
(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 refresh
|
(target version
|
||||||
(displayln "Refreshing makefile")
|
(displayln
|
||||||
(refresh-makefile)
|
(git 'next-version)))
|
||||||
(displayln "done.")
|
|
||||||
)
|
(target package
|
||||||
(target setup
|
(deps clean)
|
||||||
(raco '(setup git)))
|
(zip-package))
|
||||||
|
|
||||||
|
(target zip
|
||||||
|
(deps package))
|
||||||
|
|
||||||
|
(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)))
|
||||||
|
|
||||||
|
)
|
||||||
@@ -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)
|
||||||
```
|
```
|
||||||
|
|||||||
@@ -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"))))
|
||||||
|
|||||||
@@ -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
@@ -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
@@ -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
@@ -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
|
||||||
|
|||||||
@@ -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
@@ -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}
|
||||||
|
|
||||||
|
|||||||
Reference in New Issue
Block a user