Function: vc-git-dir-extra-headers

vc-git-dir-extra-headers is a byte-compiled function defined in vc-git.el.gz.

Signature

(vc-git-dir-extra-headers DIR)

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-git.el.gz
(defun vc-git-dir-extra-headers (dir)
  (let ((str (vc-git--out-str "symbolic-ref" "HEAD"))
	(stash-list (vc-git-stash-list))
        (default-directory dir)
        (in-progress (vc-git--cmds-in-progress))

	branch remote-url stash-button stash-string tracking-branch)
    (if (string-match "^\\(refs/heads/\\)?\\(.+\\)$" str)
	(progn
	  (setq branch (match-string 2 str))
          (let ((remote (vc-git--out-str
                         "config" (concat "branch." branch ".remote")))
                (merge (vc-git--out-str
                        "config" (concat "branch." branch ".merge"))))
            (when (string-match "\\([^\n]+\\)" remote)
	      (setq remote (match-string 1 remote)))
            (when (string-match "^\\(refs/heads/\\)?\\(.+\\)$" merge)
              (setq tracking-branch (match-string 2 merge)))
            (pcase remote
              ("."
               (setq remote-url "none (tracking local branch)"))
              ((pred (not string-empty-p))
               (setq
                remote-url (vc-git-repository-url dir remote)
                tracking-branch (concat remote "/" tracking-branch))))))
      (setq branch "none (detached HEAD)"))
    (when stash-list
      (let* ((len (length stash-list))
             (limit
              (if (integerp vc-git-show-stash)
                  (min vc-git-show-stash len)
                len))
             (shown-stashes (cl-subseq stash-list 0 limit))
             (hidden-stashes (cl-subseq stash-list limit))
             (all-hideable (or (eq vc-git-show-stash t)
                               (<= len vc-git-show-stash))))
        (setq stash-button (if all-hideable
                               (vc-git-make-stash-button nil limit limit)
                             (vc-git-make-stash-button t vc-git-show-stash len))
              stash-string
              (concat
               (when shown-stashes
                 (concat
                  (propertize "\n"
                              'vc-git-hideable all-hideable)
                  (mapconcat
                   (lambda (x)
                     (propertize x
                                 'face 'vc-dir-header-value
                                 'mouse-face 'highlight
                                 'vc-git-hideable all-hideable
                                 'help-echo vc-git-stash-list-help
                                 'keymap vc-git-stash-map))
                   shown-stashes
                   (propertize "\n"
                               'vc-git-hideable all-hideable))))
               (when hidden-stashes
                 (concat
                  (propertize "\n"
                              'invisible t
                              'vc-git-hideable t)
                  (mapconcat
                   (lambda (x)
                     (propertize x
                                 'face 'vc-dir-header-value
                                 'mouse-face 'highlight
                                 'invisible t
                                 'vc-git-hideable t
                                 'help-echo vc-git-stash-list-help
                                 'keymap vc-git-stash-map))
                   hidden-stashes
                   (propertize "\n"
                               'invisible t
                               'vc-git-hideable t))))))))
    (concat
     (propertize "Branch     : " 'face 'vc-dir-header)
     (propertize branch
		 'face 'vc-dir-header-value)
     (when tracking-branch
       (concat
        "\n"
        (propertize "Tracking   : " 'face 'vc-dir-header)
        (propertize tracking-branch 'face 'vc-dir-header-value)))
     (when remote-url
       (concat
	"\n"
	(propertize "Remote     : " 'face 'vc-dir-header)
	(propertize remote-url
		    'face 'vc-dir-header-value)))
     ;; For now just a heading, key bindings can be added later for various bisect actions
     (when (memq 'bisect in-progress)
       (propertize  "\nBisect     : in progress" 'face 'vc-dir-status-warning))
     (when (memq 'rebase in-progress)
       (propertize  "\nRebase     : in progress" 'face 'vc-dir-status-warning))
     (if stash-list
         (concat
          (propertize "\nStash      : " 'face 'vc-dir-header)
          stash-button
          stash-string)
       (concat
	(propertize "\nStash      : " 'face 'vc-dir-header)
	(propertize "Nothing stashed"
		    'help-echo vc-git-stash-shared-help
                    'keymap vc-git-stash-shared-map
		    'face 'vc-dir-header-value))))))