Fix Git branch prompt detection
ober
14fd61d8bf3ce87ddccb01a96606c07711d7c42a
--- a/prompt.ss +++ b/prompt.ss @@ -7,31 +7,59 @@ :jsh/util (only-in :jsh/expander find-matching-paren)) -;;; --- Git branch helper (reads .git/HEAD directly, no external commands) --- +;;; --- Git branch helper (supports repository directories and worktrees) --- -(def (git-branch-name) - (let loop ([dir (current-directory)]) - (let ([head-path (string-append dir "/.git/HEAD")]) - (if (file-exists? head-path) - (with-catch - (lambda (e) #f) - (lambda () - (let* ([content (call-with-input-file head-path read-line)] - [prefix "ref: refs/heads/"]) - (if (and (string? content) - (>= (string-length content) (string-length prefix)) - (string=? prefix (substring content 0 (string-length prefix)))) - (substring content (string-length prefix) (string-length content)) - ;; Detached HEAD — show short hash - (if (and (string? content) (>= (string-length content) 7)) - (substring content 0 7) - #f))))) - ;; Walk up to parent directory - (let ([parent (path-directory dir)]) - (if (or (not parent) (string=? parent dir) (string=? parent "/")) - #f - (loop parent))))))) +;; A normal repository has .git/HEAD. Worktrees and submodules instead have +;; a .git file containing "gitdir: <path>". +(def (git-head-path git-path) + (cond + [(file-exists? (string-append git-path "/HEAD")) + (string-append git-path "/HEAD")] + [(file-exists? git-path) + (with-catch + (lambda (e) #f) + (lambda () + (let* ([content (call-with-input-file git-path read-line)] + [prefix "gitdir: "]) + (and (string? content) + (>= (string-length content) (string-length prefix)) + (string=? prefix (substring content 0 (string-length prefix))) + (let ([git-dir (substring content + (string-length prefix) + (string-length content))]) + (string-append + (if (path-absolute? git-dir) + git-dir + (path-join (path-directory git-path) git-dir)) + "/HEAD"))))))] + [else #f])) +(def (read-git-branch head-path) + (with-catch + (lambda (e) #f) + (lambda () + (let* ([content (call-with-input-file head-path read-line)] + [prefix "ref: refs/heads/"]) + (if (and (string? content) + (>= (string-length content) (string-length prefix)) + (string=? prefix (substring content 0 (string-length prefix)))) + (substring content (string-length prefix) (string-length content)) + ;; Detached HEAD — show short hash. + (and (string? content) + (>= (string-length content) 7) + (substring content 0 7))))))) + +(def (git-branch-name (start-dir (or (getenv "PWD") (current-directory)))) + (let loop ([dir start-dir]) + (let* ([git-path (string-append dir "/.git")] + [head-path (git-head-path git-path)]) + (if (and head-path (file-exists? head-path)) + (read-git-branch head-path) + ;; Walk up to the parent directory. + (let ([parent (path-directory dir)]) + (if (or (not parent) (string=? parent dir) (string=? parent "/")) + #f + (loop parent))))))) ;;; --- Public interface --- ;; Expand prompt escape sequences in a PS string @@ -190,11 +218,11 @@ ((#\]) (loop (+ i 2))) ;; \g = bare branch name, \G = " (branch)" with decoration ((#\g) - (let ([branch (git-branch-name)]) + (let ([branch (git-branch-name (or (env-get "PWD") (current-directory)))]) (when branch (display branch out))) (loop (+ i 2))) ((#\G) - (let ([branch (git-branch-name)]) + (let ([branch (git-branch-name (or (env-get "PWD") (current-directory)))]) (when branch (display " (" out) (display branch out)