Re: popup menu support for smerge-mode

[Masatake YAMATO <jet@gyve.org>]

Sorry to be late to answer; and thank you for great reviewing everytime.

Thank you for great reviewing everytime.
And sorry for my poor mistakes.

> > +(easy-menu-define smerge-mode-popup-menu smerge-mode-map
> > +  "Popup menu for `smerge-mode'."
> > +  '(nil
> > +    ["Keep Current" smerge-keep-current-by-mouse :help "Use current (at point) version"]
> > +    ["Keep All" smerge-keep-all :help "Keep all three versions"]
> > +    ))
> 
> Why not just reuse the existing menu ?

Because smerge-mode-popup-menu is much smaller than smerge-mode-menu.
I assume that user may do following two things frequently:
1. keep the version under the cursur. The user can(and want to) point out 
   the version which one wants to keep by mouse. "Keep Other" and "Keep Yours"
   are not needed here.
2. keep all.
 
Of course, other menu items might be useful. But as far as trying, above two
items are `core functions' and are enough many situations. Other functions
in smerge-mode-menu should be invoked from M-x, C-c ^ or menu bar, I think.

> >  (defun smerge-auto-leave ()
> > -  (when (and smerge-auto-leave
> > -	     (save-excursion (goto-char (point-min))
> > -			     (not (re-search-forward smerge-begin-re nil t))))
> > +  (smerge-remove-overlays)
> > +  (when (and 
> > +	 ;; 1. Are conflict existed?
> > +	 ;; As the side effect, overlays are put.
> > +	 (not (save-excursion 
> > +		(goto-char (point-min))
> > +		(let (matched)
> > +		  (while (smerge-find-conflict nil t)
> > +		    (setq matched t))
> > +		  matched)))
> > +	 ;; 2. Check customize option.
> > +	 smerge-auto-leave)
> >      (smerge-mode -1)))
> 
> This is clearly wrong.  smerge-auto-leave is about leaving smerge-mode
> when all conflicts are resolved.  It shouldn't fiddle with overlays at all.
> The overlays should be removed by the call to (smerge-mode -1).

I've moved all overlay related functions from smerge-auto-leave to its 
outside.

> > +(defun smerge-put-overlay (start end)
> > +  "Put overlay of smerge-mode between START and END.
> > +The overlay has its own keymap to show popup menu."
> > +  (setq overlay (make-overlay start end))
> 
> You're modifying a global `overlay' variable here.  Please let-bind it.

I change as you wrote.

> > +  (overlay-put overlay 'mouse-face 'highlight)
> 
> Having tried it, I'm not sure whether this is a good idea or not:
> when the conflict is large, you end up with the whole window flashing
> in `highlight' face in a very annoying way.

I agree. I've changed highlight the area when and where mouse-3 is pressed.
 
> > +  (overlay-put overlay 'keymap (let ((km (make-sparse-keymap)))
> > +				 (define-key km [down-mouse-3]
> > +				   (lambda () (interactive)
> > +				     (popup-menu smerge-mode-popup-menu)))
> > +				 km))
> > +  (overlay-put overlay 'help-echo "down-mouse-3: Use current (at point) version")
> 
> The help-echo is wrong: mouse-3 does not select the version under the
> cursor (it pops up a menu instead).

I change as you wrote.
 
> > +(defun smerge-remove-overlays ()
> > +  "Delete all overlays made by  `smerge-put-overlay'."
> > +  (mapcar (lambda (o) (delete-overlay o)) smerge-overlays)
> > +  (setq smerge-overlays nil))
> 
> When the output of `mapcar' is not used you should use `mapc'.
> (lambda (x) (f x)) should always be replaced by 'f.
I change as you wrote.
 
> > +	  (when put-overlay
> > +	    (if (and base-start base-end)
> > +		(smerge-put-overlay base-start base-end))
> > +	    (if (and mine-start mine-end)
> > +		(smerge-put-overlay mine-start mine-end))
> > +	    (if (and other-start other-end)
> > +		(smerge-put-overlay other-start other-end)))
> 
> If base-start = base-end you end up with an empty overlay that the
> user cannot click on.  

I see. Now empty overlay is never put on.

> It's simpler to just place a single overlay over
> the whole conflict (including markers).

I have not done as you wrote.
I expect "Keep Current" works on the region which is highlighted.


> Also, I'm not sure it's a good idea to have a `match' function add an
> overlay like that.  Matching is not supposed to have such side effects.
> It's probably better to let the few callers that need it call
> smerge-put-overlay themselves.
> 
> 
> 	Stefan
I agree. I've moved all overlay related functions to outside of `match' 
functions.

Masatake YAMATO

cvs diff: warning: unrecognized response `access control disabled, clients can connect from any host' from cvs server
Warning: Remote host denied X11 forwarding.

Index: lisp/smerge-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/smerge-mode.el,v
retrieving revision 1.22
diff -u -r1.22 smerge-mode.el
--- lisp/smerge-mode.el	1 Sep 2003 15:45:14 -0000	1.22
+++ lisp/smerge-mode.el	18 Sep 2003 08:30:56 -0000
@@ -137,6 +137,8 @@
   `((,smerge-command-prefix . ,smerge-basic-map))
   "Keymap for `smerge-mode'.")
 
+(defvar smerge-overlays nil "Overlays managed by smerge-mode")
+
 (easy-menu-define smerge-mode-menu smerge-mode-map
   "Menu for `smerge-mode'."
   '("SMerge"
@@ -159,6 +161,13 @@
      :help "Use Ediff to resolve the conflicts"]
     ))
 
+(easy-menu-define smerge-mode-popup-menu smerge-mode-map
+  "Popup menu for `smerge-mode'."
+  '(nil
+    ["Keep this"   smerge-keep-current-by-mouse :help "Use current (at point) version"]
+    ["Keep All" smerge-keep-all :help "Keep all three versions"]
+    ))
+
 (defconst smerge-font-lock-keywords
   '((smerge-find-conflict
      (1 smerge-mine-face prepend t)
@@ -199,11 +208,13 @@
     (error (format "No `%s'" (aref smerge-match-names n)))))
 
 (defun smerge-auto-leave ()
+  "Turn smerge-mode off and return t if no conflict is found.
+Just return nil if a conflict is found."
   (when (and smerge-auto-leave
 	     (save-excursion (goto-char (point-min))
 			     (not (re-search-forward smerge-begin-re nil t))))
-    (smerge-mode -1)))
-
+    (smerge-mode -1)
+    t))
 
 (defun smerge-keep-all ()
   "Keep all three versions.
@@ -214,7 +225,8 @@
 			 (or (match-string 2) "")
 			 (or (match-string 3) ""))
 		 t t)
-  (smerge-auto-leave))
+  (unless (smerge-auto-leave)
+    (smerge-reset-all-overlays)))
 
 (defun smerge-combine-with-next ()
   "Combine the current conflict with the next one."
@@ -262,7 +274,8 @@
   (interactive)
   (smerge-match-conflict)
   (funcall smerge-resolve-function)
-  (smerge-auto-leave))
+  (unless (smerge-auto-leave)
+    (smerge-reset-all-overlays)))
 
 (defun smerge-keep-base ()
   "Revert to the base version."
@@ -270,7 +283,8 @@
   (smerge-match-conflict)
   (smerge-ensure-match 2)
   (replace-match (match-string 2) t t)
-  (smerge-auto-leave))
+  (unless (smerge-auto-leave)
+    (smerge-reset-all-overlays)))
 
 (defun smerge-keep-other ()
   "Use \"other\" version."
@@ -278,7 +292,8 @@
   (smerge-match-conflict)
   ;;(smerge-ensure-match 3)
   (replace-match (match-string 3) t t)
-  (smerge-auto-leave))
+  (unless (smerge-auto-leave)
+    (smerge-reset-all-overlays)))
 
 (defun smerge-keep-mine ()
   "Keep your version."
@@ -286,7 +301,8 @@
   (smerge-match-conflict)
   ;;(smerge-ensure-match 1)
   (replace-match (match-string 1) t t)
-  (smerge-auto-leave))
+  (unless (smerge-auto-leave)
+    (smerge-reset-all-overlays)))
 
 (defun smerge-keep-current ()
   "Use the current (under the cursor) version."
@@ -299,7 +315,17 @@
       (decf i))
     (if (<= i 0) (error "Not inside a version")
       (replace-match (match-string i) t t)
-      (smerge-auto-leave))))
+      (unless (smerge-auto-leave)
+	(smerge-reset-all-overlays)))))
+
+(defun smerge-keep-current-by-mouse (event)
+  "Call `smerge-keep-current'at the place where you clicked by a mouse."
+  (interactive "e")
+  (save-excursion
+    (set-buffer (window-buffer (posn-window (event-end event))))
+    (save-excursion
+      (goto-char (posn-point (event-end event)))
+      (smerge-keep-current))))
 
 (defun smerge-diff-base-mine ()
   "Diff 'base' and 'mine' version in current conflict region."
@@ -316,6 +342,50 @@
   (interactive)
   (smerge-diff 1 3))
 
+(defun smerge-reset-all-overlays ()
+  "Delete all overlays of smerge-mode and put overlays on the all conflicts again."
+  (smerge-delete-overlays)
+  (save-excursion 
+    (goto-char (point-min))
+    (while (smerge-find-conflict nil)
+      (smerge-put-overlays (cddr (match-data))))))
+
+(defun smerge-put-overlays (match-data)
+  "Put overlays of smerge-mode on the place specified by MATCH-DATA."
+  (let (b e)
+    (while match-data
+      (setq b (car match-data)
+	    e (cadr match-data)
+	    match-data (cddr match-data))
+      (if (and b e (not (eq b e)))
+	  (smerge-put-overlay b e)))))
+
+(defun smerge-put-overlay (start end)
+  "Put overlay of smerge-mode between START and END.
+The overlay has its own keymap to show popup menu."
+  (let ((overlay (make-overlay start end)))
+      (overlay-put overlay 'keymap (let ((km (make-sparse-keymap)))
+				     (define-key km [down-mouse-3] 
+				       (lambda (event) (interactive "e")
+					 (save-excursion
+					   (set-buffer (window-buffer (posn-window (event-end event))))
+					   (save-excursion
+					     (let (o)
+					       (goto-char (posn-point (event-end event)))
+					       (setq o (car (overlays-at (point))))
+					       (overlay-put o 'face 'region)
+					       (sit-for 0) ; redisplay
+					       (popup-menu smerge-mode-popup-menu)
+					       (overlay-put o 'face nil))))))
+				     km))
+      (overlay-put overlay 'help-echo "down-mouse-3: Show popup small menu")
+      (push overlay smerge-overlays)))
+
+(defun smerge-delete-overlays ()
+  "Delete all overlays made by  `smerge-put-overlay'."
+  (mapc 'delete-overlay smerge-overlays)
+  (setq smerge-overlays nil))
+
 (defun smerge-match-conflict ()
   "Get info about the conflict.  Puts the info in the `match-data'.
 The submatches contain:
@@ -522,6 +592,12 @@
   "Minor mode to simplify editing output from the diff3 program.
 \\{smerge-mode-map}"
   nil " SMerge" nil
+  ;; overlays management
+  (if smerge-mode
+      ;; entering smerge-mode
+      (set (make-variable-buffer-local 'smerge-overlays) nil)
+    ;; leaving smerge-mode
+    (smerge-delete-overlays)) 
   (when (and (boundp 'font-lock-mode) font-lock-mode)
     (set (make-local-variable 'font-lock-multiline) t)
     (save-excursion
@@ -529,9 +605,10 @@
 	  (font-lock-add-keywords nil smerge-font-lock-keywords 'append)
 	(font-lock-remove-keywords nil smerge-font-lock-keywords))
       (goto-char (point-min))
-      (while (smerge-find-conflict)
+      (while (smerge-find-conflict nil)
 	(save-excursion
-	  (font-lock-fontify-region (match-beginning 0) (match-end 0) nil))))))
+	  (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)
+	  (smerge-put-overlays (cddr (match-data))))))))
 
 
 (provide 'smerge-mode)