[Emacs-diffs] /srv/bzr/emacs/trunk r102848: * lisp/vc/smerge-mode.el: Resolve comment conflicts more aggressively.

[Stefan Monnier]

------------------------------------------------------------
revno: 102848
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Fri 2011-01-14 13:10:15 -0500
message:
  * 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.
modified:
  lisp/ChangeLog
  lisp/newcomment.el
  lisp/vc/smerge-mode.el

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-01-14 17:42:40 +0000
+++ b/lisp/ChangeLog    2011-01-14 18:10:15 +0000
@@ -1,3 +1,12 @@
+2011-01-14  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>  (tiny change)
 
        * abbrev.el (prepare-abbrev-list-buffer): If listing local abbrev

=== modified file 'lisp/newcomment.el'
--- a/lisp/newcomment.el        2011-01-14 17:18:41 +0000
+++ b/lisp/newcomment.el        2011-01-14 18:10:15 +0000
@@ -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))
 

=== modified file 'lisp/vc/smerge-mode.el'
--- a/lisp/vc/smerge-mode.el    2011-01-14 17:18:41 +0000
+++ b/lisp/vc/smerge-mode.el    2011-01-14 18:10:15 +0000
@@ -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))