Re: popup menu support for smerge-mode

[Masatake YAMATO]

Several month ago, I wrote: 
> I've added popup menu support in smerge-mode.
> Could you evaluate my patch? and if you prefer, please
> add the patch to official source tree.

Stefan Monnier wrote:
> Looks like a good idea.  The patch has some problems (the menu and mouse-face
> stays after the conflict is resolved and even after smerge-mode is turned 
> off),
> but I'll take care of it.

I've rewritten the patch using overlays. Overlays are removed after smerge-mode 
is 
turned off. Please, review.

2003-08-24  Masatake YAMATO  <address@hidden>

        * smerge-mode.el (smerge-overlays): New variable.
        (smerge-mode-popup-menu): New menu.
        (smerge-auto-leave): Call `smerge-find-conflict' to put overlays.
        (smerge-keep-current-by-mouse): New function.
        (smerge-put-overlay): New function.
        (smerge-delete-overlays): New function.
        (smerge-match-conflict): Put overlay here.
        (smerge-find-conflict): Add new argument `put-overlay'.
        (smerge-mode): Add code to manage overlays.


Index: lisp/smerge-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/smerge-mode.el,v
retrieving revision 1.21
diff -u -r1.21 smerge-mode.el
--- lisp/smerge-mode.el 4 Feb 2003 12:05:02 -0000       1.21
+++ lisp/smerge-mode.el 24 Aug 2003 05:50:28 -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 Current" 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,9 +208,18 @@
     (error (format "No `%s'" (aref smerge-match-names n)))))
 
 (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)))
 
 
@@ -301,6 +319,15 @@
       (replace-match (match-string i) t t)
       (smerge-auto-leave))))
 
+(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."
   (interactive)
@@ -316,14 +343,33 @@
   (interactive)
   (smerge-diff 1 3))
 
-(defun smerge-match-conflict ()
+(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))
+  (overlay-put overlay 'mouse-face 'highlight)
+  (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")
+  (push overlay smerge-overlays))
+
+(defun smerge-remove-overlays ()
+  "Delete all overlays made by  `smerge-put-overlay'."
+  (mapcar (lambda (o) (delete-overlay o)) smerge-overlays)
+  (setq smerge-overlays nil))
+
+(defun smerge-match-conflict (&optional put-overlay)
   "Get info about the conflict.  Puts the info in the `match-data'.
 The submatches contain:
  0:  the whole conflict.
  1:  your code.
  2:  the base code.
  3:  other code.
-An error is raised if not inside a conflict."
+An error is raised if not inside a conflict.
+Overlays for smerge popup menu are put if PUT-OVERLAY is non-nil."
   (save-excursion
     (condition-case nil
        (let* ((orig-point (point))
@@ -370,7 +416,13 @@
           (setq base-end   mine-end)
           (setq mine-start other-start)
           (setq mine-end   other-end)))
-
+         (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)))
          (store-match-data (list start end
                                  mine-start mine-end
                                  base-start base-end
@@ -380,14 +432,16 @@
          t)
       (search-failed (error "Point not in conflict region")))))
 
-(defun smerge-find-conflict (&optional limit)
+(defun smerge-find-conflict (&optional limit put-overlay)
   "Find and match a conflict region.  Intended as a font-lock MATCHER.
 The submatches are the same as in `smerge-match-conflict'.
 Returns non-nil if a match is found between the point and LIMIT.
-The point is moved to the end of the conflict."
+The point is moved to the end of the conflict.
+If PUT-OVERLAY is non-nil, overlays for smerge popup menu are put 
+as side effect."
   (when (re-search-forward smerge-begin-re limit t)
     (ignore-errors
-      (smerge-match-conflict)
+      (smerge-match-conflict put-overlay)
       (goto-char (match-end 0)))))
 
 (defun smerge-diff (n1 n2)
@@ -522,6 +576,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-remove-overlays)) 
   (when (and (boundp 'font-lock-mode) font-lock-mode)
     (set (make-local-variable 'font-lock-multiline) t)
     (save-excursion
@@ -529,7 +589,7 @@
          (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 smerge-mode)
        (save-excursion
          (font-lock-fontify-region (match-beginning 0) (match-end 0) nil))))))