changeset 995:1e4b009b379e

Emacs support: add hg-revert-buffer.

--- a/contrib/mercurial.el	Sun Aug 21 16:00:07 2005 -0700
+++ b/contrib/mercurial.el	Sun Aug 21 21:51:01 2005 -0800
@@ -100,6 +100,12 @@
   :type 'integer
   :group 'mercurial)
 
+(defcustom hg-update-modeline t
+  "Whether to update the modeline with the status of a file after every save.
+Set this to nil on platforms with poor process management, such as Windows."
+  :type 'boolean
+  :group 'mercurial)
+
 
 ;;; Other variables.
 
@@ -137,7 +143,7 @@
 (define-key hg-prefix-map "l" 'hg-log)
 (define-key hg-prefix-map "n" 'hg-commit-file)
 ;; (define-key hg-prefix-map "r" 'hg-update)
-(define-key hg-prefix-map "u" 'hg-revert-file)
+(define-key hg-prefix-map "u" 'hg-revert-buffer)
 (define-key hg-prefix-map "~" 'hg-version-other-window)
 
 (defvar hg-mode-map (make-sparse-keymap))
@@ -189,12 +195,12 @@
 
 ;;; Convenience functions.
 
-(defun hg-binary ()
+(defsubst hg-binary ()
   (if hg-binary
       hg-binary
     (error "No `hg' executable found!")))
 
-(defun hg-replace-in-string (str regexp newtext &optional literal)
+(defsubst hg-replace-in-string (str regexp newtext &optional literal)
   "Replace all matches in STR for REGEXP with NEWTEXT string.
 Return the new string.  Optional LITERAL non-nil means do a literal
 replacement.
@@ -205,7 +211,7 @@
       (replace-in-string str regexp newtext literal)
     (replace-regexp-in-string regexp newtext str nil literal)))
 
-(defun hg-chomp (str)
+(defsubst hg-chomp (str)
   "Strip trailing newlines from a string."
   (hg-replace-in-string str "[\r\n]+$" ""))
 
@@ -268,7 +274,8 @@
   (defun view-minor-mode (prev-buffer exit-func)
     (view-mode)))
 
-(defun hg-abbrev-file-name (file)
+(defsubst hg-abbrev-file-name (file)
+  "Portable wrapper around abbreviate-file-name."
   (if hg-running-xemacs
       (abbreviate-file-name file t)
     (abbreviate-file-name file)))
@@ -341,7 +348,8 @@
 	(let ((state (assoc (substring output 0 (min (length output) 2))
 			    '(("M " . modified)
 			      ("A " . added)
-			      ("R " . removed)))))
+			      ("R " . removed)
+			      ("? " . nil)))))
 	  (if state
 	      (cdr state)
 	    'normal)))))
@@ -381,10 +389,54 @@
 
 (put 'hg-view-output 'lisp-indent-function 1)
 
+;;; Context save and restore across revert.
+
+(defun hg-position-context (pos)
+  "Return information to help find the given position again."
+  (let* ((end (min (point-max) (+ pos 98))))
+    (list pos
+	  (buffer-substring (max (point-min) (- pos 2)) end)
+	  (- end pos))))
+
+(defun hg-buffer-context ()
+  "Return information to help restore a user's editing context.
+This is useful across reverts and merges, where a context is likely
+to have moved a little, but not really changed."
+  (let ((point-context (hg-position-context (point)))
+	(mark-context (let ((mark (mark-marker)))
+			(and mark (hg-position-context mark)))))
+    (list point-context mark-context)))
+	
+(defun hg-find-context (ctx)
+  "Attempt to find a context in the given buffer.
+Always returns a valid, hopefully sane, position."
+  (let ((pos (nth 0 ctx))
+	(str (nth 1 ctx))
+	(fixup (nth 2 ctx)))
+    (save-excursion
+      (goto-char (max (point-min) (- pos 15000)))
+      (if (and (not (equal str ""))
+	       (search-forward str nil t))
+	  (- (point) fixup)
+	(max pos (point-min))))))
+
+(defun hg-restore-context (ctx)
+  "Attempt to restore the user's editing context."
+  (let ((point-context (nth 0 ctx))
+	(mark-context (nth 1 ctx)))
+    (goto-char (hg-find-context point-context))
+    (when mark-context
+      (set-mark (hg-find-context mark-context)))))
+
+
 ;;; Hooks.
 
-(defun hg-mode-line ()
-  (when (hg-root)
+(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)))
       (setq hg-status status
 	    hg-mode (and status (concat " Hg:"
@@ -438,7 +490,7 @@
 
 Tell Mercurial to manage a file       G    C-c h a      hg-add
 Commit changes to current file only   L    C-x v n      hg-commit
-Undo changes to file since commit     L    C-x v u      hg-revert-file
+Undo changes to file since commit     L    C-x v u      hg-revert-buffer
 
 Diff file vs last checkin             L    C-x v =      hg-diff
 
@@ -488,7 +540,10 @@
 		     (hg-read-rev " to start with")
 		     (let ((rev2 (hg-read-rev " to end with" 'working-dir)))
 		       (and (not (eq rev2 'working-dir)) rev2))))
-  (let ((a-path (hg-abbrev-file-name path)))
+  (unless rev1
+    (setq rev1 "-1"))
+  (let ((a-path (hg-abbrev-file-name path))
+	diff)
     (hg-view-output ((if (equal rev1 rev2)
 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
 		       (format "Mercurial: Rev %s to %s of %s"
@@ -497,7 +552,9 @@
 	  (call-process (hg-binary) nil t nil "diff" "-r" rev1 "-r" rev2 path)
 	(call-process (hg-binary) nil t nil "diff" "-r" rev1 path))
       (diff-mode)
-      (font-lock-fontify-buffer))))
+      (setq diff (not (= (point-min) (point-max))))
+      (font-lock-fontify-buffer))
+    diff))
 
 (defun hg-forget (path)
   (interactive (list (hg-read-file-name " to forget")))
@@ -521,8 +578,6 @@
   (interactive (list (hg-read-file-name " to log")
 		     (hg-read-rev " to start with" "-1")
 		     (hg-read-rev " to end with" (format "-%d" hg-log-limit))))
-  (message "log %s %s" rev1 rev2)
-  (sit-for 1)
   (let ((a-path (hg-abbrev-file-name path)))
     (hg-view-output ((if (equal rev1 rev2)
 			 (format "Mercurial: Rev %s of %s" rev1 a-path)
@@ -544,13 +599,33 @@
   (interactive)
   (error "not implemented"))
 
-(defun hg-revert ()
-  (interactive)
-  (error "not implemented"))
+(defun hg-revert-buffer-internal ()
+  (let ((ctx (hg-buffer-context)))
+    (message "Reverting %s..." buffer-file-name)
+    (hg-run0 "revert" buffer-file-name)
+    (revert-buffer t t t)
+    (hg-restore-context ctx)
+    (hg-mode-line)
+    (message "Reverting %s...done" buffer-file-name)))
 
-(defun hg-revert-file ()
+(defun hg-revert-buffer ()
   (interactive)
-  (error "not implemented"))
+  (let ((vc-suppress-confirm nil)
+	(obuf (current-buffer))
+	diff)
+    (vc-buffer-sync)
+    (unwind-protect
+	(setq diff (hg-diff buffer-file-name))
+      (when diff
+	(unless (yes-or-no-p "Discard changes? ")
+	  (error "Revert cancelled")))
+      (when diff
+	(let ((buf (current-buffer)))
+	  (delete-window (selected-window))
+	  (kill-buffer buf))))
+    (set-buffer obuf)
+    (when diff
+      (hg-revert-buffer-internal))))
 
 (defun hg-root (&optional path)
   (interactive (list (hg-read-file-name)))
@@ -587,6 +662,5 @@
 
 
 ;;; Local Variables:
-;;; mode: emacs-lisp
 ;;; prompt-to-byte-compile: nil
 ;;; end: