+(defstruct (vc-hg-extra-fileinfo
+ (:copier nil)
+ (:constructor vc-hg-create-extra-fileinfo (rename-state extra-name))
+ (:conc-name vc-hg-extra-fileinfo->))
+ rename-state ;; rename or copy state
+ extra-name) ;; original name for copies and rename targets, new name for
+
+(declare-function vc-default-status-printer "vc-dir" (backend fileentry))
+
+(defun vc-hg-status-printer (info)
+ "Pretty-printer for the vc-dir-fileinfo structure."
+ (let ((extra (vc-dir-fileinfo->extra info)))
+ (vc-default-status-printer 'Hg info)
+ (when extra
+ (insert (propertize
+ (format " (%s %s)"
+ (case (vc-hg-extra-fileinfo->rename-state extra)
+ ('copied "copied from")
+ ('renamed-from "renamed from")
+ ('renamed-to "renamed to"))
+ (vc-hg-extra-fileinfo->extra-name extra))
+ 'face 'font-lock-comment-face)))))
+
+(defun vc-hg-after-dir-status (update-function)
+ (let ((status-char nil)
+ (file nil)
+ (translation '((?= . up-to-date)
+ (?C . up-to-date)
+ (?A . added)
+ (?R . removed)
+ (?M . edited)
+ (?I . ignored)
+ (?! . missing)
+ (? . copy-rename-line)
+ (?? . unregistered)))
+ (translated nil)
+ (result nil)
+ (last-added nil)
+ (last-line-copy nil))
+ (goto-char (point-min))
+ (while (not (eobp))
+ (setq translated (cdr (assoc (char-after) translation)))
+ (setq file
+ (buffer-substring-no-properties (+ (point) 2)
+ (line-end-position)))
+ (cond ((not translated)
+ (setq last-line-copy nil))
+ ((eq translated 'up-to-date)
+ (setq last-line-copy nil))
+ ((eq translated 'copy-rename-line)
+ ;; For copied files the output looks like this:
+ ;; A COPIED_FILE_NAME
+ ;; ORIGINAL_FILE_NAME
+ (setf (nth 2 last-added)
+ (vc-hg-create-extra-fileinfo 'copied file))
+ (setq last-line-copy t))
+ ((and last-line-copy (eq translated 'removed))
+ ;; For renamed files the output looks like this:
+ ;; A NEW_FILE_NAME
+ ;; ORIGINAL_FILE_NAME
+ ;; R ORIGINAL_FILE_NAME
+ ;; We need to adjust the previous entry to not think it is a copy.
+ (setf (vc-hg-extra-fileinfo->rename-state (nth 2 last-added))
+ 'renamed-from)
+ (push (list file translated
+ (vc-hg-create-extra-fileinfo
+ 'renamed-to (nth 0 last-added))) result)
+ (setq last-line-copy nil))
+ (t
+ (setq last-added (list file translated nil))
+ (push last-added result)
+ (setq last-line-copy nil)))
+ (forward-line))
+ (funcall update-function result)))
+
+(defun vc-hg-dir-status (dir update-function)
+ (vc-hg-command (current-buffer) 'async dir "status" "-C")
+ (vc-exec-after
+ `(vc-hg-after-dir-status (quote ,update-function))))
+
+(defun vc-hg-dir-status-files (dir files default-state update-function)
+ (apply 'vc-hg-command (current-buffer) 'async dir "status" "-C" files)
+ (vc-exec-after
+ `(vc-hg-after-dir-status (quote ,update-function))))
+
+(defun vc-hg-status-extra-header (name &rest commands)
+ (concat (propertize name 'face 'font-lock-type-face)
+ (propertize
+ (with-temp-buffer
+ (apply 'vc-hg-command (current-buffer) 0 nil commands)
+ (buffer-substring-no-properties (point-min) (1- (point-max))))
+ 'face 'font-lock-variable-name-face)))
+
+(defun vc-hg-status-extra-headers (dir)
+ "Generate extra status headers for a Mercurial tree."
+ (let ((default-directory dir))
+ (concat
+ (vc-hg-status-extra-header "Root : " "root") "\n"
+ (vc-hg-status-extra-header "Branch : " "id" "-b") "\n"
+ (vc-hg-status-extra-header "Tags : " "id" "-t") ; "\n"
+ ;; these change after each commit
+ ;; (vc-hg-status-extra-header "Local num : " "id" "-n") "\n"
+ ;; (vc-hg-status-extra-header "Global id : " "id" "-i")
+ )))
+
+;; FIXME: this adds another top level menu, instead figure out how to