From e8fde58867c6423b961c1ed2b618cdc7f473b740 Mon Sep 17 00:00:00 2001
From: Hans Dijkema <hans@dijkewijk.nl>
Date: Tue, 11 Aug 2026 13:59:52 +0200
Subject: [PATCH] added git 'add '-A command

---
 main.rkt | 92 ++++++--------------------------------------------------
 1 file changed, 9 insertions(+), 83 deletions(-)

diff --git a/main.rkt b/main.rkt
index dd02e28..f7f5228 100644
--- a/main.rkt
+++ b/main.rkt
@@ -27,14 +27,11 @@
          git-commit
          git-head
          git-current-branch
-         git-switch
          git-branches
-         git-branch-create
          git-branch
          git-branch-delete
          git-checkout
          git-checkout-new
-         git-merge
          git-tags
          git-tag
          git-tag-delete
@@ -69,7 +66,6 @@
 (define GIT-CREDTYPE-USERNAME #x0020)
 (define GIT-PASSTHROUGH -30)
 (define GIT-CHECKOUT-OPTIONS-VERSION 1)
-(define GIT-MERGE-OPTIONS-VERSION 1)
 
 (define (git-credential-callback out url username-from-url allowed-types _payload)
   ;; Never let a Racket exception escape through a C callback.  In particular,
@@ -554,23 +550,18 @@
    #"")
   (sort branches string<?))
 
-(define (git-branch-create name [start-point "HEAD"])
+(define (create-branch name)
   (define repo (open-repository))
-  (define object
-    (with-handlers ([exn:fail?
-                     (lambda (_)
-                       (error 'git-branch-create
-                              "cannot resolve start point: ~a"
-                              start-point))])
-      (git_revparse_single repo (format "~a^{commit}" start-point))))
-  (define commit (git_commit_lookup repo (git_object_id object)))
+  (define commit (head-commit repo))
+  (unless commit
+    (error 'git-branch "cannot create a branch before the first commit"))
   (git_branch_create repo name commit #f)
   name)
 
 (define git-branch
   (case-lambda
     [() (git-branches)]
-    [(name) (git-branch-create name)]))
+    [(name) (create-branch name)]))
 
 (define (git-branch-delete name)
   (define repo (open-repository))
@@ -587,12 +578,6 @@
   (git_checkout_options_init options GIT-CHECKOUT-OPTIONS-VERSION)
   options)
 
-(define (make-merge-options)
-  (define options
-    (cast (malloc _git_merge_opts 'atomic) _pointer _git_merge_opts-pointer))
-  (git_merge_options_init options GIT-MERGE-OPTIONS-VERSION)
-  options)
-
 (define (git-checkout name)
   (define repo (open-repository))
   (define options (make-safe-checkout-options))
@@ -610,65 +595,10 @@
      (git_repository_set_head_detached repo (git_object_id object))])
   (git-head))
 
-(define (git-switch name)
-  (unless (member name (git-branches))
-    (error 'git-switch "no such local branch: ~a" name))
-  (git-checkout name))
-
 (define (git-checkout-new name)
   (git-branch name)
   (git-checkout name))
 
-(define (git-merge name [message #f])
-  (define repo (open-repository))
-  (define branch (git-current-branch))
-  (unless branch
-    (error 'git-merge "merge requires an attached local branch"))
-  (define ours (head-commit repo))
-  (unless ours
-    (error 'git-merge "cannot merge into a repository without commits"))
-  (define target-object
-    (with-handlers ([exn:fail?
-                     (lambda (_)
-                       (error 'git-merge "cannot resolve merge target: ~a" name))])
-      (git_revparse_single repo (format "~a^{commit}" name))))
-  (define theirs (git_commit_lookup repo (git_object_id target-object)))
-  (define ours-id (git_commit_id ours))
-  (define theirs-id (git_commit_id theirs))
-  (cond
-    ;; The target is already contained in HEAD.
-    [(or (git_oid_equal ours-id theirs-id)
-         (git_graph_descendant_of repo ours-id theirs-id))
-     #f]
-    ;; HEAD is an ancestor of the target: do a real fast-forward, including
-    ;; index and worktree, and keep HEAD attached to the current branch.
-    [(git_graph_descendant_of repo theirs-id ours-id)
-     (git_checkout_tree repo target-object (make-safe-checkout-options))
-     (define local-ref
-       (git_reference_lookup repo (string-append branch-prefix branch)))
-     (git_reference_set_target
-      local-ref theirs-id (format "merge ~a: fast-forward" name))
-     (git_oid_fmt theirs-id)]
-    [else
-     ;; Build the merge in an in-memory index first. Conflicts therefore leave
-     ;; HEAD, the worktree, and the repository index untouched.
-     (define merge-index (git_merge_commits repo ours theirs (make-merge-options)))
-     (when (git_index_has_conflicts merge-index)
-       (error 'git-merge "merge conflicts while merging ~a" name))
-     (define tree-id (blank-oid))
-     (git_index_write_tree_to tree-id merge-index repo)
-     (define tree (git_tree_lookup repo tree-id))
-     ;; Safe checkout refuses to overwrite uncommitted worktree changes.
-     (git_checkout_tree repo (cast tree _git_tree _git_object)
-                        (make-safe-checkout-options))
-     (define signature (git_signature_default repo))
-     (define commit-id (blank-oid))
-     (git_commit_create_v
-      commit-id repo "HEAD" signature signature #f
-      (or message (format "Merge branch '~a'" name))
-      tree 2 ours theirs)
-     (git_oid_fmt commit-id)]))
-
 (define (git-tags)
   (define tags null)
   (git_tag_foreach
@@ -900,20 +830,16 @@
     [(clone) (keyword-apply git-clone '(#:quiet) (list quiet) args)]
     [(status) (apply git-status args)]
     [(diff) (apply git-diff args)]
-    [(add) (apply git-add args)]
+    [(add)
+     (if (and (= (length args) 1) (eq? (car args) '-A))
+         (apply git-add (map git-status-entry-path (git 'status)))
+         (apply git-add args))]
     [(config) (apply git-config args)]
     [(commit) (apply git-commit args)]
-    [(branch-current)
-     (unless (null? args)
-       (error 'git "branch-current takes no arguments"))
-     (git-current-branch)]
     [(branch)
      (match args
        [(list '-d name) (git-branch-delete name)]
        [_ (apply git-branch args)])]
-    [(branch-create) (apply git-branch-create args)]
-    [(switch) (apply git-switch args)]
-    [(merge) (apply git-merge args)]
     [(checkout)
      (match args
        [(list '-b name) (git-checkout-new name)]