Re: popup menu support for smerge-mode

[Masatake YAMATO]

[resending]
I've found a time to revise my patch about popup menu support 
for smerge-mode. Stefan, don't angry with me. I hope you do not forget
the old patch... A patch for popup menu for smerge-mode in my local 
machine is too useful to me to throw away:-)

> > mine and other uses special menus. I added "Keep alternative" to the
> > menus.  Other including whole uses the smerge menu appeared on the
> > menu bar.
> 
> Don't forget that conflicts can have a 3-parts shape where there's not just
> "mine" and "other" but also the ancestor, in which case there's no single
> "Keep alternative".

I've added "Revert to the BASE" to the popup menu.

> > +(easy-menu-define smerge-mode-mine-popup-menu nil
> > +  "Popup menu for mine area in `smerge-mode'."
> > +  '(nil
> > +    ["Keep This" smerge-keep-current :help "Use current (at point) 
> > version"]
> > +    ;; mine <-> other
> > +    ["Keep Alternative" smerge-keep-other :help "Use alternative version"] 
> > +    ["Keep All" smerge-keep-all :help "Keep all three versions"]
> > +    "---"
> > +    ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode 
> > menu"]
> > +    ))
> > +(easy-menu-define smerge-mode-other-popup-menu nil
> > +  "Popup menu for other area in `smerge-mode'."
> > +  '(nil
> > +    ["Keep This"   smerge-keep-current :help "Use current (at point) 
> > version"]
> > +    ;; other <-> mine
> > +    ["Keep Alternative" smerge-keep-mine :help "Use alternative version"]
> > +    ["Keep All"    smerge-keep-all :help "Keep all three versions"]
> > +    "---"
> > +    ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode 
> > menu"]
> > +    ))
> 
> I'd rather introduce a new function smerge-keep-alternative which
> will determine whether to use `other' or `mine' depending on `current'.
> This way there's only one menu rather than two with the same appearance
> but different behavior.

I wrote `smerge-keep-alternative' and unified the above two menus.

> > +      (when (and b e (not (= b e)))
> 
> I think this can be simplified to `unless (eq e b)' because `e' and `b'
> are either both locations or both nil.

I have used `unless'.

> > +   ;; Delete overlays
> > +   (when (or 
> > +          (not (overlay-buffer o-whole)) ;; dead
> > +          (< (- (overlay-end o-whole) (overlay-start o-whole))
> > +             region-whole))              ;; shrinked up
> > +     (mapc 'delete-overlay (cons o-whole os-sub)))))))
> 
> I agree it's easier to remove the overlays from smerge-activate-popup-menu,
> but that means they'll just never be removed if the user doesn't use
> this new feature.  I think it really needs to be done somewhere else
> instead (E.g. at the same place as the auto-leave code is run.  We'll
> probably need to introduce a new function `smerge-post-resolution-update'
> which will do the auto-leave check and will remove the overlays).

Removing overlays in smerge-post-resolution-update(or auto-leave) is not easy
because the some part of text area associated with the overlays are removed
during "resolution". Instead I put the code(smerge-delete-overlays-at) to 
delete overlays before "resolution".

Index: lisp/smerge-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/smerge-mode.el,v
retrieving revision 1.24
diff -u -r1.24 smerge-mode.el
--- lisp/smerge-mode.el 6 Oct 2003 16:34:59 -0000       1.24
+++ lisp/smerge-mode.el 10 Mar 2004 04:27:49 -0000
@@ -159,6 +159,22 @@
      :help "Use Ediff to resolve the conflicts"]
     ))
 
+(defvar smerge-overlays nil "Overlays managed by smerge-mode")
+(easy-mmode-defmap smerge-popup-menu-map
+  `(([down-mouse-3] . smerge-activate-popup-menu))
+  "Keymap for popup menu appeared on conflicts area.")
+(easy-menu-define smerge-mode-popup-menu nil
+  "Popup menu for mine area in `smerge-mode'."
+  '(nil
+    ["Keep All" smerge-keep-all :help "Keep all three versions"]
+    ["Revert to the Base" smerge-keep-base :help "Revert to the base version"]
+    ["Keep This" smerge-keep-current :help "Use current (at point) version"]
+    ["Keep Alternative" smerge-keep-alternative :help "Use alternative 
version"] 
+    "---"
+    ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode 
menu"]
+    ))
+
+
 (defconst smerge-font-lock-keywords
   '((smerge-find-conflict
      (1 smerge-mine-face prepend t)
@@ -198,18 +214,35 @@
   (unless (match-end n)
     (error (format "No `%s'" (aref smerge-match-names n)))))
 
+(defun smerge-delete-overlays-at (pos)
+  "Delete overlays used in Smerge mode under POS."
+  (let  ((overlays (overlays-at pos))
+        o
+        suboverlays)
+    (while overlays
+      (setq o (car overlays)
+           overlays (cdr overlays)
+           suboverlays (overlay-get o 'suboverlays))
+      (when suboverlays
+       (setq suboverlays (cons o suboverlays)
+             overlays nil)))
+    (mapc 'delete-overlay suboverlays)))
+
 (defun smerge-auto-leave ()
+  "If no conflict left, turn off Smerge mode.
+Return non-nil if the mode was indeed turned off."
   (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.
 Convenient for the kind of conflicts that can arise in ChangeLog files."
   (interactive)
   (smerge-match-conflict)
+  (smerge-delete-overlays-at (point))
   (replace-match (concat (or (match-string 1) "")
                         (or (match-string 2) "")
                         (or (match-string 3) ""))
@@ -261,6 +294,7 @@
 some major modes.  Uses `smerge-resolve-function' to do the actual work."
   (interactive)
   (smerge-match-conflict)
+  (smerge-delete-overlays-at (point))
   (funcall smerge-resolve-function)
   (smerge-auto-leave))
 
@@ -269,6 +303,7 @@
   (interactive)
   (smerge-match-conflict)
   (smerge-ensure-match 2)
+  (smerge-delete-overlays-at (point))
   (replace-match (match-string 2) t t)
   (smerge-auto-leave))
 
@@ -277,6 +312,7 @@
   (interactive)
   (smerge-match-conflict)
   ;;(smerge-ensure-match 3)
+  (smerge-delete-overlays-at (point))
   (replace-match (match-string 3) t t)
   (smerge-auto-leave))
 
@@ -285,6 +321,7 @@
   (interactive)
   (smerge-match-conflict)
   ;;(smerge-ensure-match 1)
+  (smerge-delete-overlays-at (point))
   (replace-match (match-string 1) t t)
   (smerge-auto-leave))
 
@@ -298,9 +335,28 @@
               (>= (point) (match-end i)))
       (decf i))
     (if (<= i 0) (error "Not inside a version")
+      (smerge-delete-overlays-at (point))
       (replace-match (match-string i) t t)
       (smerge-auto-leave))))
 
+(defun smerge-keep-alternative ()
+  "Use the alternatives (not under the cursor) version."
+  (interactive)
+  (smerge-match-conflict)
+  (let ((i 3))
+    (while (or (not (match-end i))
+              (< (point) (match-beginning i))
+              (>= (point) (match-end i)))
+      (decf i))
+    (cond
+     ((<= i 0) (error "Not inside a version"))
+     ((eq i 2) (error "No alternative for the base version"))
+     ((eq i 3) (setq i 1))
+     ((eq i 1) (setq i 3)))
+    (smerge-delete-overlays-at (point))
+    (replace-match (match-string i) t t) 
+    (smerge-auto-leave)))
+
 (defun smerge-diff-base-mine ()
   "Diff 'base' and 'mine' version in current conflict region."
   (interactive)
@@ -316,6 +372,93 @@
   (interactive)
   (smerge-diff 1 3))
 
+(defun smerge-put-overlays (match-data)
+  "Put overlays of smerge-mode on the place specified by MATCH-DATA."
+  (let ((m (cddr match-data))
+       (owners '(mine base other base-start other-start))
+       (b-whole (car match-data))
+       (e-whole (cadr match-data))
+       b e o os)
+    (while m
+      (setq b (car m)
+           e (cadr m)
+           m (cddr m)
+           o (car owners)
+           owners (cdr owners))
+      (unless (eq e b)
+       (push (smerge-put-highlight-overlay b e o)
+             os)))
+    ;; highlight overlays are managed by keymap overlay.
+    ;; When keymap overlay is shrinked or removed, 
+    ;; highlight overlays are removed.
+    (smerge-put-keymap-overlay b-whole e-whole os)))
+    
+(defun smerge-put-highlight-overlay (start end owner)
+  "Put overlay of smerge-mode between START and END.
+The overlay is highlight when it is pressed.
+OWNER is stored to `owner' property of the new overlay."
+  (let ((overlay (make-overlay start end)))
+    (overlay-put overlay 'evaporate t)
+    (overlay-put overlay 'owner owner)
+    (push overlay smerge-overlays)
+    overlay))
+
+(defun smerge-put-keymap-overlay (start end suboverlays)
+  "Put overlay of smerge-mode between START and END.
+The overlay has its own keymap to show popup menu.
+SUBOVERLAYS are overlays managed by this overlay."
+  (let ((overlay (make-overlay start end)))
+    (overlay-put overlay 'evaporate t)
+    (overlay-put overlay 'help-echo "down-mouse-3: Show popup menu")
+    (overlay-put overlay 'local-map smerge-popup-menu-map)
+    (overlay-put overlay 'owner 'whole)
+    (overlay-put overlay 'suboverlays suboverlays)
+    (push overlay smerge-overlays)
+    overlay))
+
+(defun smerge-activate-popup-menu (event)
+  "Show a popup menu for smerge-mode."
+  (interactive "e")
+  (with-current-buffer (window-buffer 
+                       (posn-window (event-end event)))
+    (save-excursion
+      (goto-char (posn-point (event-end event)))
+      (let ((overlays (overlays-at (point)))
+           overlay 
+           face menu)
+       (while overlays
+         (let* ((o (car overlays))
+                (owner (overlay-get o 'owner)))
+           ;; Find mine or other. If such owner is found,
+           ;; we can overwrite `overlay' local variable.
+           (cond
+            ((or (eq 'mine owner) (eq 'other owner))
+             (setq overlay o
+                   face    'region
+                   menu     smerge-mode-popup-menu
+                   overlays nil))
+            ;; Find whole. If such owner is found.
+            ;; we can set `overlay' local variable 
+            ;;if overlay is not set yet.
+            ((and (eq 'whole owner) (not overlay))
+             (setq overlay  o
+                   face    'highlight
+                   menu     smerge-mode-menu))
+            (t 
+             (setq overlays (cdr overlays))))))
+       (unwind-protect
+           (progn
+             (overlay-put overlay 'face face)
+             (sit-for 0)                     ;; redisplay
+             (popup-menu menu))
+         (overlay-put overlay 'face nil))))))
+
+
+(defun smerge-delete-all-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 +665,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
+      (make-variable-buffer-local 'smerge-overlays)
+    ;; leaving smerge-mode
+    (smerge-delete-all-overlays)) 
   (when (and (boundp 'font-lock-mode) font-lock-mode)
     (set (make-local-variable 'font-lock-multiline) t)
     (save-excursion
@@ -531,8 +680,8 @@
       (goto-char (point-min))
       (while (smerge-find-conflict)
        (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 (match-data)))))))
 
 (provide 'smerge-mode)