changeset 112231:f4a73cf7587b

* lisp/vc/smerge-mode.el: Resolve comment conflicts more aggressively. (smerge-resolve--normalize-re): New var. (smerge-resolve--extract-comment, smerge-resolve--normalize): New funs. (smerge-resolve): Use them. * lisp/newcomment.el (comment-only-p): New function. (comment-or-uncomment-region): Use it.
author Stefan Monnier <monnier@iro.umontreal.ca>
date Fri, 14 Jan 2011 13:10:15 -0500
parents c1e8771a1716
children 3b840e622de1
files lisp/ChangeLog lisp/newcomment.el lisp/vc/smerge-mode.el
diffstat 3 files changed, 87 insertions(+), 6 deletions(-) [+]
line wrap: on
line diff
--- a/lisp/ChangeLog	Fri Jan 14 13:06:07 2011 -0500
+++ b/lisp/ChangeLog	Fri Jan 14 13:10:15 2011 -0500
@@ -1,3 +1,12 @@
+2011-01-14  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* vc/smerge-mode.el: Resolve comment conflicts more aggressively.
+	(smerge-resolve--normalize-re): New var.
+	(smerge-resolve--extract-comment, smerge-resolve--normalize): New funs.
+	(smerge-resolve): Use them.
+	* newcomment.el (comment-only-p): New function.
+	(comment-or-uncomment-region): Use it.
+
 2011-01-14  Brent Goodrick  <bgoodr@gmail.com>  (tiny change)
 
 	* abbrev.el (prepare-abbrev-list-buffer): If listing local abbrev
--- a/lisp/newcomment.el	Fri Jan 14 13:06:07 2011 -0500
+++ b/lisp/newcomment.el	Fri Jan 14 13:10:15 2011 -0500
@@ -1185,6 +1185,12 @@
 			   'box-multi 'box)))
     (comment-region beg end (+ comment-add arg))))
 
+(defun comment-only-p (beg end)
+  "Return non-nil if the text between BEG and END is all comments."
+  (save-excursion
+    (goto-char beg)
+    (comment-forward (point-max))
+    (<= end (point))))
 
 ;;;###autoload
 (defun comment-or-uncomment-region (beg end &optional arg)
@@ -1193,10 +1199,7 @@
 is passed on to the respective function."
   (interactive "*r\nP")
   (comment-normalize-vars)
-  (funcall (if (save-excursion ;; check for already commented region
-		 (goto-char beg)
-		 (comment-forward (point-max))
-		 (<= end (point)))
+  (funcall (if (comment-only-p beg end)
 	       'uncomment-region 'comment-region)
 	   beg end arg))
 
--- a/lisp/vc/smerge-mode.el	Fri Jan 14 13:06:07 2011 -0500
+++ b/lisp/vc/smerge-mode.el	Fri Jan 14 13:10:15 2011 -0500
@@ -46,7 +46,7 @@
 
 (eval-when-compile (require 'cl))
 (require 'diff-mode)                    ;For diff-auto-refine-mode.
-
+(require 'newcomment)
 
 ;;; The real definition comes later.
 (defvar smerge-mode)
@@ -455,6 +455,37 @@
               (insert ">>>>>>> " name3 "\n")
               (setq line endline))))))))
 
+(defconst smerge-resolve--normalize-re "[\n\t][ \t\n]*\\| [ \t\n]+")
+
+(defun smerge-resolve--extract-comment (beg end)
+  "Extract the text within the comments that span BEG..END."
+  (save-excursion
+    (let ((comments ())
+          combeg)
+      (goto-char beg)
+      (while (and (< (point) end)
+                  (setq combeg (comment-search-forward end t)))
+        (let ((beg (point)))
+          (goto-char combeg)
+          (comment-forward 1)
+          (save-excursion
+            (comment-enter-backward)
+            (push " " comments)
+            (push (buffer-substring-no-properties beg (point)) comments))))
+      (push " " comments)
+      (with-temp-buffer
+        (apply #'insert (nreverse comments))
+        (goto-char (point-min))
+        (while (re-search-forward smerge-resolve--normalize-re
+                                  nil t)
+          (replace-match " "))
+        (buffer-string)))))
+
+(defun smerge-resolve--normalize (beg end)
+  (replace-regexp-in-string
+   smerge-resolve--normalize-re " "
+   (concat " " (buffer-substring-no-properties beg end) " ")))
+
 (defun smerge-resolve (&optional safe)
   "Resolve the conflict at point intelligently.
 This relies on mode-specific knowledge and thus only works in some
@@ -472,7 +503,8 @@
 	(m2e (match-end 2))
 	(m3e (match-end 3))
 	(buf (generate-new-buffer " *smerge*"))
-        m b o)
+        m b o
+        choice)
     (unwind-protect
 	(progn
           (cond
@@ -557,6 +589,43 @@
 	      (narrow-to-region m0b m0e)
               (smerge-remove-props m0b m0e)
 	      (insert-file-contents m nil nil nil t)))
+           ;; If the conflict is only made of comments, and one of the two
+           ;; changes is only rearranging spaces (e.g. reflowing text) while
+           ;; the other is a real change, drop the space-rearrangement.
+           ((and m2e
+                 (comment-only-p m1b m1e)
+                 (comment-only-p m2b m2e)
+                 (comment-only-p m3b m3e)
+                 (let ((t1 (smerge-resolve--extract-comment m1b m1e))
+                       (t2 (smerge-resolve--extract-comment m2b m2e))
+                       (t3 (smerge-resolve--extract-comment m3b m3e)))
+                   (cond
+                    ((and (equal t1 t2) (not (equal t2 t3)))
+                     (setq choice 3))
+                    ((and (not (equal t1 t2)) (equal t2 t3))
+                     (setq choice 1)))))
+            (set-match-data md)
+	    (smerge-keep-n choice))
+           ;; Idem, when the conflict is contained within a single comment.
+           ((save-excursion
+              (and m2e
+                   (nth 4 (syntax-ppss m0b))
+                   ;; If there's a conflict earlier in the file,
+                   ;; syntax-ppss is not reliable.
+                   (not (re-search-backward smerge-begin-re nil t))
+                   (progn (goto-char (nth 8 (syntax-ppss m0b)))
+                          (forward-comment 1)
+                          (> (point) m0e))
+                   (let ((t1 (smerge-resolve--normalize m1b m1e))
+                         (t2 (smerge-resolve--normalize m2b m2e))
+                         (t3 (smerge-resolve--normalize m3b m3e)))
+                     (cond
+                    ((and (equal t1 t2) (not (equal t2 t3)))
+                     (setq choice 3))
+                    ((and (not (equal t1 t2)) (equal t2 t3))
+                     (setq choice 1))))))
+            (set-match-data md)
+	    (smerge-keep-n choice))
            (t
             (error "Don't know how to resolve"))))
       (if (buffer-name buf) (kill-buffer buf))