Small changes. git main function is now a real function, not syntax

This commit is contained in:
2026-08-13 02:00:08 +02:00
parent a025481ae4
commit 2cb7e9310e
3 changed files with 82 additions and 58 deletions
+1 -1
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.10") (define version "0.3.11")
(define pkg-authors '("Hans Dijkema")) (define pkg-authors '("Hans Dijkema"))
(define license 'MIT) (define license 'MIT)
+54 -31
View File
@@ -22,25 +22,29 @@
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Provided commands ;; Internal variables
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define git-commands (make-hash)) (define git-commands (make-hash))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Command invocation using 'git'
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; goal: Invoke a supported Git command through the command table. ;; goal: Invoke a supported Git command through the command table.
;; pre: command is a registered Git command symbol. ;; pre: command is a registered Git command symbol.
;; post: The selected command has processed all supplied arguments. ;; post: The selected command has processed all supplied arguments.
;; result: The command-specific result. ;; result: The command-specific result.
(define-syntax git
(syntax-rules () (define (git command . args)
((_ command b1 ...)
((hash-ref git-commands command ((hash-ref git-commands command
(λ () (λ ()
(error "Not a supported or recognized git command: " command))) (error "Not a supported or recognized git command: " command)))
(list b1 ...))) args))
)
) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Supporting functions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-prompt p) (define (git-prompt p)
(display p) (display p)
@@ -76,6 +80,9 @@
(string-contains? line* "no changes added to commit")))) (string-contains? line* "no changes added to commit"))))
out)) out))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Command definition macro
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-syntax def-cmd (define-syntax def-cmd
(syntax-rules () (syntax-rules ()
@@ -93,6 +100,10 @@
) )
) )
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Typical git commands
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; goal: Return the complete Git index and worktree status for every reported file. ;; goal: Return the complete Git index and worktree status for every reported file.
;; pre: The current directory is inside a Git working tree. ;; pre: The current directory is inside a Git working tree.
;; post: Git status has been invoked with --porcelain. ;; post: Git status has been invoked with --porcelain.
@@ -154,7 +165,9 @@
;; post: Git pull has completed successfully or an exception has been raised. ;; post: Git pull has completed successfully or an exception has been raised.
;; result: #t after a successful pull. ;; result: #t after a successful pull.
(def-cmd git-pull cmd-git-pull 'pull) (def-cmd git-pull cmd-git-pull 'pull)
(def-cmd git-branch cmd-git-branch 'branch) (def-cmd git-branch cmd-git-branch 'branch)
(def-cmd git-clone cmd-git-clone 'clone) (def-cmd git-clone cmd-git-clone 'clone)
;; goal: Display the Git commit log. ;; goal: Display the Git commit log.
@@ -162,32 +175,9 @@
;; post: Git log has completed successfully or an exception has been raised. ;; post: Git log has completed successfully or an exception has been raised.
;; result: #t after successfully displaying the log. ;; result: #t after successfully displaying the log.
(def-cmd git-log cmd-git-log 'log) (def-cmd git-log cmd-git-log 'log)
(def-cmd git-rev-list cmd-git-rev-list 'rev-list) (def-cmd git-rev-list cmd-git-rev-list 'rev-list)
(define (git-version . args)
(cmd-git-version args))
(define (cmd-git-version args)
(info-version "."))
(hash-set! git-commands 'version cmd-git-version)
;; goal: Increment the package version in info.rkt.
;; pre: kind is 'maj, 'major, 'min, 'minor or 'patch.
;; post: The version definition in info.rkt has been updated.
;; result: The new version as a list containing major, minor and patch.
(define (git-new-version . args)
(cmd-git-new-version args))
(define (cmd-git-new-version args)
(when(null? args)
(error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch"))
(let ((kind (car args)))
(git-next-version kind ".")
(git-version)))
(hash-set! git-commands 'new-version cmd-git-new-version)
(def-cmd git-diff cmd-git-diff 'diff (def-cmd git-diff cmd-git-diff 'diff
(λ (args info) args) (λ (args info) args)
(λ (cmd exit-code result output out info) (λ (cmd exit-code result output out info)
@@ -257,3 +247,36 @@
(def-cmd git-help cmd-git-help 'help) (def-cmd git-help cmd-git-help 'help)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Racket module versioning
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (git-version . args)
(cmd-git-version args))
(define (cmd-git-version args)
(info-version "."))
(hash-set! git-commands 'version cmd-git-version)
;; goal: Increment the package version in info.rkt.
;; pre: kind is 'maj, 'major, 'min, 'minor or 'patch.
;; post: The version definition in info.rkt has been updated.
;; result: The new version as a list containing major, minor and patch.
(define (git-new-version . args)
(cmd-git-new-version args))
(define (cmd-git-new-version args)
(when(null? args)
(error "git-new-version expects 'maj, 'major, 'min, 'minor or 'patch"))
(let ((kind (car args)))
(git-next-version kind ".")
(git-version)))
(hash-set! git-commands 'new-version cmd-git-new-version)
+2 -1
View File
@@ -1,7 +1,8 @@
#lang scribble/manual #lang scribble/manual
@(require (for-label racket/base @(require (for-label racket/base
git-cli)) "../main.rkt"))
@;git-cli))
@title[#:tag "top"]{git-cli} @title[#:tag "top"]{git-cli}
@author{Hans Dijkema} @author{Hans Dijkema}