Initial commit

git-purr.scm

@@ -0,0 +1,33 @@
+#!/usr/bin/csi -ss
+(import (chicken format) (chicken process) (chicken process-context) (chicken process-context posix))
+(define commands
+  '("add" "am" "archive" "backfill" "bisect" "branch" "bundle" "checkout" "cherry-pick" "citool" "clean"
+    "clone" "commit" "describe" "diff" "fetch" "format-patch" "gc" "grep" "gui" "init" "log" "maintenance"
+    "merge" "mv" "notes" "pull" "push" "range-diff" "rebase" "reset" "restore" "revert" "rm" "shortlog"
+    "show" "sparse-checkout" "stash" "status" "submodule" "switch" "tag" "worktree" "config" "fast-export"
+    "fast-import" "filter-branch" "mergetool" "pack-refs" "prune" "reflog" "refs" "remote" "repack" "replace"
+    "annotate" "blame" "bugreport" "count-objects" "diagnose" "difftool" "fsck" "help" "instaweb" "merge-tree"
+    "rerere" "show-branch" "verify-commit" "verify-tag" "version" "whatchanged" "archimport" "cvsexportcommit"
+    "cvsimport" "cvsserver" "imap-send" "p4" "quiltimport" "request-pull" "send-email" "svn" "apply"
+    "checkout-index" "commit-graph" "commit-tree" "hash-object" "index-pack" "merge-file" "merge-index"
+    "mktag" "mktree" "multi-pack-index" "pack-objects" "prune-packed" "read-tree" "replay" "symbolic-ref"
+    "unpack-objects" "update-index" "update-ref" "write-tree" "cat-file" "cherry" "diff-files" "diff-index"
+    "diff-pairs" "diff-tree" "for-each-ref" "for-each-repo" "get-tar-commit-id" "ls-files" "ls-remote"
+    "ls-tree" "merge-base" "name-rev" "pack-redundant" "rev-list" "rev-parse" "show-index" "show-ref"
+    "unpack-file" "var" "verify-pack" "daemon" "fetch-pack" "http-backend" "send-pack" "update-server-info"))
+(define (main args)
+  (let* ((config-file-path (sprintf "~a/git-purr/config.scm"
+                                    (or (get-environment-variable "XDG_CONFIG_HOME")
+                                        (sprintf "~a/.config" (get-environment-variable "HOME")))))
+         (config (with-input-from-file config-file-path read))
+         (git-args (let loop ((args args) (acc '()))
+                     (if (null? args)
+                         (reverse acc)
+                         (let* ((command (car args))
+                                (rest (cdr args))
+                                (alias (alist-ref command config equal?)))
+                           (cond (alias (append (reverse acc) (cons alias rest)))
+                                 ((member command commands) (append (reverse acc) args))
+                                 (else (loop rest (cons command acc))))))))) 
+    (process-execute "git" git-args)))
+(cond-expand (compiling (main (command-line-arguments))) (else))