47 lines
3.2 KiB
Scheme
Executable file
47 lines
3.2 KiB
Scheme
Executable file
#!/usr/bin/csi -ss
|
||
;; git-purr.scm – a silly script for making aliases for git commands
|
||
;; Copyright (C) 2025 afiw
|
||
;;
|
||
;; This program is free software: you can redistribute it and/or modify
|
||
;; it under the terms of the GNU General Public License as published by
|
||
;; the Free Software Foundation, exclusively version 3 of the License.
|
||
;;
|
||
;; This program is distributed in the hope that it will be useful,
|
||
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
||
;; GNU General Public License for more details.
|
||
;;
|
||
;; You should have received a copy of the GNU General Public License
|
||
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||
(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))
|