mercurial.el: speed up mode line updates.
--- a/contrib/mercurial.el Tue Aug 22 11:37:18 2006 -0700
+++ b/contrib/mercurial.el Tue Aug 22 14:02:43 2006 -0700
@@ -502,6 +502,43 @@
(or default "tip")))
rev))))
+(defun hg-parents-for-mode-line (root)
+ "Format the parents of the working directory for the mode line."
+ (let ((parents (split-string (hg-chomp
+ (hg-run0 "--cwd" root "parents" "--template"
+ "{rev}\n")) "\n")))
+ (mapconcat 'identity parents "+")))
+
+(defun hg-buffers-visiting-repo (&optional path)
+ "Return a list of buffers visiting the repository containing PATH."
+ (let ((root-name (hg-root (or path (buffer-file-name))))
+ bufs)
+ (save-excursion
+ (dolist (buf (buffer-list) bufs)
+ (set-buffer buf)
+ (let ((name (buffer-file-name)))
+ (when (and hg-status name (equal (hg-root name) root-name))
+ (setq bufs (cons buf bufs))))))))
+
+(defun hg-update-mode-lines (path)
+ "Update the mode lines of all buffers visiting the same repository as PATH."
+ (let* ((root (hg-root path))
+ (parents (hg-parents-for-mode-line root)))
+ (save-excursion
+ (dolist (info (hg-path-status
+ root
+ (mapcar
+ (function
+ (lambda (buf)
+ (substring (buffer-file-name buf) (length root))))
+ (hg-buffers-visiting-repo root))))
+ (let* ((name (car info))
+ (status (cdr info))
+ (buf (find-buffer-visiting (concat root name))))
+ (when buf
+ (set-buffer buf)
+ (hg-mode-line-internal status parents)))))))
+
(defmacro hg-do-across-repo (path &rest body)
(let ((root-name (gensym "root-"))
(buf-name (gensym "buf-")))
@@ -554,10 +591,10 @@
(cdr state)
'normal)))))
-(defun hg-status (&rest paths)
- "Return status of PATHS as an alist.
+(defun hg-path-status (root paths)
+ "Return status of PATHS in repo ROOT as an alist.
Each entry is a pair (FILE-NAME . STATUS)."
- (let ((s (apply 'hg-run "status" "-marduc" paths))
+ (let ((s (apply 'hg-run "--cwd" root "status" "-marduc" paths))
result)
(dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
(let ((state (cdr (assoc (substring entry 0 2)
@@ -569,7 +606,7 @@
("I " . ignored)
("? " . nil)))))
(name (substring entry 2)))
- (setq result (cons (cons name state) result)))))))
+ (setq result (cons (cons name state) result))))))
(defmacro hg-view-output (args &rest body)
"Execute BODY in a clean buffer, then quickly display that buffer.
@@ -646,25 +683,28 @@
;;; Hooks.
+(defun hg-mode-line-internal (status parents)
+ (setq hg-status status
+ hg-mode (and status (concat " Hg:"
+ parents
+ (cdr (assq status
+ '((normal . "")
+ (removed . "r")
+ (added . "a")
+ (deleted . "!")
+ (modified . "m"))))))))
+
(defun hg-mode-line (&optional force)
"Update the modeline with the current status of a file.
An update occurs if optional argument FORCE is non-nil,
hg-update-modeline is non-nil, or we have not yet checked the state of
the file."
- (when (and (hg-root) (or force hg-update-modeline (not hg-mode)))
- (let ((status (hg-file-status buffer-file-name))
- (parents
- (split-string (hg-chomp
- (hg-run0 "parents" "--template" "{rev}\n")) "\n")))
- (setq hg-status status
- hg-mode (and status (concat " Hg:"
- (mapconcat 'identity parents "+")
- (cdr (assq status
- '((normal . "")
- (removed . "r")
- (added . "a")
- (modified . "m")))))))
- status)))
+ (let ((root (hg-root)))
+ (when (and root (or force hg-update-modeline (not hg-mode)))
+ (let ((status (hg-file-status buffer-file-name))
+ (parents (hg-parents-for-mode-line root)))
+ (hg-mode-line-internal status parents)
+ status))))
(defun hg-mode (&optional toggle)
"Minor mode for Mercurial distributed SCM integration.
@@ -844,8 +884,7 @@
(let ((buf hg-prev-buffer))
(kill-buffer nil)
(switch-to-buffer buf))
- (hg-do-across-repo root
- (hg-mode-line)))))
+ (hg-update-mode-lines root))))
(defun hg-commit-mode ()
"Mode for describing a commit of changes to a Mercurial repository.