comparison contrib/mercurial.el @ 3002:65efeb7b2c56

mercurial.el: speed up mode line updates.

3001:a7c4c7537999

			     nil
			     'hg-rev-history
			     (or default "tip")))
	rev))))

(defmacro hg-do-across-repo (path &rest body)
  (let ((root-name (gensym "root-"))
	(buf-name (gensym "buf-")))
    `(let ((,root-name (hg-root ,path)))
       (save-excursion

			      ("? " . nil)))))
	  (if state
	      (cdr state)
	    'normal)))))

(defun hg-status (&rest paths)
  "Return status of PATHS as an alist.
Each entry is a pair (FILE-NAME . STATUS)."
  (let ((s (apply 'hg-run "status" "-marduc" paths))
	 result)
      (dolist (entry (split-string (hg-chomp (cdr s)) "\n") (nreverse result))
	(let ((state (cdr (assoc (substring entry 0 2)
				 '(("M " . modified)
				   ("A " . added)

				   ("! " . deleted)
				   ("C " . normal)
				   ("I " . ignored)
				   ("? " . nil)))))
	      (name (substring entry 2)))
	  (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.
If the buffer contains one line, its contents are displayed in the
minibuffer.  Otherwise, the buffer is displayed in view-mode.

      (set-mark (hg-find-context mark-context)))))


;;; Hooks.

(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)))

(defun hg-mode (&optional toggle)
  "Minor mode for Mercurial distributed SCM integration.

The Mercurial mode user interface is based on that of VC mode, so if

	(setq message (concat message "\n"))
	(apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
      (let ((buf hg-prev-buffer))
	(kill-buffer nil)
	(switch-to-buffer buf))
      (hg-do-across-repo root
	(hg-mode-line)))))

(defun hg-commit-mode ()
  "Mode for describing a commit of changes to a Mercurial repository.
This involves two actions: describing the changes with a commit
message, and choosing the files to commit.

3002:65efeb7b2c56

			     nil
			     'hg-rev-history
			     (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-")))
    `(let ((,root-name (hg-root ,path)))
       (save-excursion

			      ("? " . nil)))))
	  (if state
	      (cdr state)
	    'normal)))))

(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 "--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)
				 '(("M " . modified)
				   ("A " . added)

				   ("! " . deleted)
				   ("C " . normal)
				   ("I " . ignored)
				   ("? " . nil)))))
	      (name (substring entry 2)))
	  (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.
If the buffer contains one line, its contents are displayed in the
minibuffer.  Otherwise, the buffer is displayed in view-mode.

      (set-mark (hg-find-context mark-context)))))


;;; 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."
  (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.

The Mercurial mode user interface is based on that of VC mode, so if

	(setq message (concat message "\n"))
	(apply 'hg-run0 "--cwd" hg-root "commit" "-m" message files))
      (let ((buf hg-prev-buffer))
	(kill-buffer nil)
	(switch-to-buffer buf))
      (hg-update-mode-lines root))))

(defun hg-commit-mode ()
  "Mode for describing a commit of changes to a Mercurial repository.
This involves two actions: describing the changes with a commit
message, and choosing the files to commit.