Function: vc-bzr-dir-extra-headers

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

Signature

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

Source Code

;; Defined in /usr/src/emacs/lisp/vc/vc-bzr.el.gz
(defun vc-bzr-dir-extra-headers (dir)
  (let*
      ((str (with-temp-buffer
	      (vc-bzr-command "info" t 0 dir)
	      (buffer-string)))
       (shelve (vc-bzr-shelve-list))
       (shelve-help-echo (substitute-command-keys
                          "Use \\[vc-bzr-shelve] to create shelves"))
       (root-dir (vc-bzr-root dir))
       (pending-merge
	;; FIXME: looking for .bzr/checkout/merge-hashes is not a
	;; reliable method to detect pending merges, disable this
	;; until a proper solution is implemented.
	(and nil
	 (file-exists-p
	 (expand-file-name ".bzr/checkout/merge-hashes" root-dir))))
       (pending-merge-help-echo
	(format "A merge has been performed.\nA commit from the top-level directory (%s)\nis required before being able to check in anything else" root-dir))
       (light-checkout
	(when (string-match ".+light checkout root: \\(.+\\)$" str)
	  (match-string 1 str)))
       (light-checkout-branch
	(when light-checkout
	  (when (string-match ".+checkout of branch: \\(.+\\)$" str)
	    (match-string 1 str)))))
    (concat
     (propertize "Parent branch      : " 'face 'vc-dir-header)
     (propertize
      (if (string-match "parent branch: \\(.+\\)$" str)
          (match-string 1 str)
        "None")
       'face 'vc-dir-header-value)
     "\n"
      (when light-checkout
	(concat
	 (propertize "Light checkout root: " 'face 'vc-dir-header)
	 (propertize light-checkout 'face 'vc-dir-header-value)
	 "\n"))
      (when light-checkout-branch
	(concat
	 (propertize "Checkout of branch : " 'face 'vc-dir-header)
	 (propertize light-checkout-branch 'face 'vc-dir-header-value)
	 "\n"))
      (when pending-merge
	(concat
	 (propertize "Warning            : " 'face 'vc-dir-status-warning
		     'help-echo pending-merge-help-echo)
	 (propertize "Pending merges, commit recommended before any other action"
		     'help-echo pending-merge-help-echo
		     'face 'vc-dir-status-warning)
	 "\n"))
      (if shelve
	  (concat
	   (propertize "Shelves            :\n" 'face 'vc-dir-header
		       'help-echo shelve-help-echo)
	   (mapconcat
	    (lambda (x)
	      (propertize x
			  'face 'vc-dir-header-value
			  'mouse-face 'highlight
			  'help-echo "mouse-3: Show shelve menu\nA: Apply and keep shelf\nP: Apply and remove shelf (pop)\nS: Snapshot to a shelf\nC-k: Delete shelf"
			  'keymap vc-bzr-shelve-map))
	    shelve "\n"))
	(concat
	 (propertize "Shelves            : " 'face 'vc-dir-header
		     'help-echo shelve-help-echo)
	 (propertize "No shelved changes"
		     'help-echo shelve-help-echo
		     'face 'vc-dir-header-value))))))