2004-03-15 Masatake YAMATO <jet@gyve.org>

	Added context menu support in smerge mode.
	Most of the part is written by Stefan Monnier.

	* smerge-mode.el (smerge-context-menu-map, smerge-context-menu): New
	keyman and menu.
	(smerge-text-properties): New function.
	(smerge-remove-props): New function.
	(smerge-popup-context-menu): New function.
	(smerge-resolve): Call `smerge-remove-props'.
	(smerge-keep-base, smerge-keep-other, smerge-keep-mine):
	Ditto.
	(smerge-keep-current): Ditto.
	(smerge-kill-current): New function.
	(smerge-match-conflict): Detect the file as `a same-diff conflict'
	if the filename is "ANCESTOR". Put text properties.

2 files changed, 112 insertions, 16 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5a4799a913f..b9c938a089b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,21 @@
+2004-03-15  Masatake YAMATO  <jet@gyve.org>
+
+        Added context menu support in smerge mode.
+        Most of the part is written by Stefan Monnier.
+        
+        * smerge-mode.el (smerge-context-menu-map, smerge-context-menu): New
+        keyman and menu.
+        (smerge-text-properties): New function.
+        (smerge-remove-props): New function.
+        (smerge-popup-context-menu): New function.
+        (smerge-resolve): Call `smerge-remove-props'.
+        (smerge-keep-base, smerge-keep-other, smerge-keep-mine):
+        Ditto.
+        (smerge-keep-current): Ditto.
+        (smerge-kill-current): New function.
+        (smerge-match-conflict): Detect the file as `a same-diff conflict'
+        if the filename is "ANCESTOR". Put text properties.
+
 2004-03-15  David Ponce  <david@dponce.com>
 
         * ruler-mode.el: (ruler-mode-left-fringe-cols)
diff --git a/lisp/smerge-mode.el b/lisp/smerge-mode.el
index 711ceefedc0..742de9c2b96 100644
--- a/lisp/smerge-mode.el
+++ b/lisp/smerge-mode.el
@@ -3,8 +3,7 @@
 ;; Copyright (C) 1999, 2000, 01, 03, 2004  Free Software Foundation, Inc.
 
 ;; Author: Stefan Monnier <monnier@cs.yale.edu>
-;; Keywords: merge diff3 cvs conflict
-;; Revision: $Id: smerge-mode.el,v 1.24 2003/10/06 16:34:59 fx Exp $
+;; Keywords: revision-control merge diff3 cvs conflict
 
 ;; This file is part of GNU Emacs.
 
@@ -187,6 +186,19 @@ Used in `smerge-diff-base-mine' and related functions."
      :active (smerge-check 1)]
     ))
 
+(easy-mmode-defmap smerge-context-menu-map
+  `(([down-mouse-3] . smerge-activate-context-menu))
+  "Keymap for context menu appeared on conflicts area.")
+(easy-menu-define smerge-context-menu nil
+  "Context menu for mine area in `smerge-mode'."
+  '(nil
+    ["Keep Current" smerge-keep-current :help "Use current (at point) version"]
+    ["Kill Current" smerge-kill-current :help "Remove current (at point) version"]
+    ["Keep All" smerge-keep-all :help "Keep all three versions"]
+    "---"
+    ["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)
@@ -283,12 +295,53 @@ Convenient for the kind of conflicts that can arise in ChangeLog files."
 The function is called with no argument and with the match data set
 according to `smerge-match-conflict'.")
 
+(defvar smerge-text-properties
+  `(help-echo "merge conflict: mouse-3 shows a menu"
+    ;; mouse-face highlight
+    keymap (keymap (down-mouse-3 . smerge-popup-context-menu))))
+
+(defun smerge-remove-props (&optional beg end)
+  (remove-text-properties
+   (or beg (match-beginning 0))
+   (or end (match-end 0))
+   smerge-text-properties))
+
+(defun smerge-popup-context-menu (event)
+  "Pop up the Smerge mode context menu under mouse."
+  (interactive "e")
+  (if (and smerge-mode
+          (save-excursion (mouse-set-point event) (smerge-check 1)))
+      (progn
+       (mouse-set-point event)
+       (smerge-match-conflict)
+       (let ((i (smerge-get-current))
+             o)
+         (if (<= i 0)
+             ;; Out of range
+             (popup-menu smerge-mode-menu)
+           ;; Install overlay.
+           (setq o (make-overlay (match-beginning i) (match-end i)))  
+           (overlay-put o 'face 'highlight)
+           (sit-for 0)
+           (popup-menu (if (smerge-check 2) 
+                           smerge-mode-menu
+                           smerge-context-menu))
+           ;; Delete overlay.
+           (delete-overlay o))))
+    ;; There's no conflict at point, the text-props are just obsolete.
+    (save-excursion
+      (let ((beg (re-search-backward smerge-end-re nil t))
+           (end (re-search-forward smerge-begin-re nil t)))
+       (smerge-remove-props (or beg (point-min)) (or end (point-max)))
+       (push event unread-command-events)))))
+
 (defun smerge-resolve ()
   "Resolve the conflict at point intelligently.
 This relies on mode-specific knowledge and thus only works in
 some major modes.  Uses `smerge-resolve-function' to do the actual work."
   (interactive)
   (smerge-match-conflict)
+  (smerge-remove-props)
   (funcall smerge-resolve-function)
   (smerge-auto-leave))
 
@@ -297,6 +350,7 @@ some major modes.  Uses `smerge-resolve-function' to do the actual work."
   (interactive)
   (smerge-match-conflict)
   (smerge-ensure-match 2)
+  (smerge-remove-props)
   (replace-match (match-string 2) t t)
   (smerge-auto-leave))
 
@@ -305,6 +359,7 @@ some major modes.  Uses `smerge-resolve-function' to do the actual work."
   (interactive)
   (smerge-match-conflict)
   ;;(smerge-ensure-match 3)
+  (smerge-remove-props)
   (replace-match (match-string 3) t t)
   (smerge-auto-leave))
 
@@ -313,6 +368,7 @@ some major modes.  Uses `smerge-resolve-function' to do the actual work."
   (interactive)
   (smerge-match-conflict)
   ;;(smerge-ensure-match 1)
+  (smerge-remove-props)
   (replace-match (match-string 1) t t)
   (smerge-auto-leave))
 
@@ -330,9 +386,23 @@ some major modes.  Uses `smerge-resolve-function' to do the actual work."
   (smerge-match-conflict)
   (let ((i (smerge-get-current)))
     (if (<= i 0) (error "Not inside a version")
+      (smerge-remove-props)
       (replace-match (match-string i) t t)
       (smerge-auto-leave))))
 
+(defun smerge-kill-current ()
+  "Remove the current (under the cursor) version."
+  (interactive)
+  (smerge-match-conflict)
+  (let ((i (smerge-get-current)))
+    (if (<= i 0) (error "Not inside a version")
+      (smerge-remove-props)
+      (replace-match (mapconcat
+                      (lambda (j)
+                        (match-string j))
+                      (remove i '(1 2 3)) "") t t)
+      (smerge-auto-leave))))
+
 (defun smerge-diff-base-mine ()
   "Diff 'base' and 'mine' version in current conflict region."
   (interactive)
@@ -389,20 +459,28 @@ An error is raised if not inside a conflict."
             (setq mine-end (match-beginning 0))
             (setq base-start (match-end 0)))
 
-          ((string= filename (file-name-nondirectory
-                              (or buffer-file-name "")))
-           ;; a 2-parts conflict
-           (set (make-local-variable 'smerge-conflict-style) 'diff3-E))
-
-          ((and (not base-start)
-                (or (eq smerge-conflict-style 'diff3-A)
-                    (string-match "^[.0-9]+\\'" filename)))
-           ;; a same-diff conflict
-           (setq base-start mine-start)
-           (setq base-end   mine-end)
-           (setq mine-start other-start)
-           (setq mine-end   other-end)))
-
+           ((string= filename (file-name-nondirectory
+                               (or buffer-file-name "")))
+            ;; a 2-parts conflict
+            (set (make-local-variable 'smerge-conflict-style) 'diff3-E))
+
+           ((and (not base-start)
+                 (or (eq smerge-conflict-style 'diff3-A)
+                     (equal filename "ANCESTOR")
+                     (string-match "\\`[.0-9]+\\'" filename)))
+            ;; a same-diff conflict
+            (setq base-start mine-start)
+            (setq base-end   mine-end)
+            (setq mine-start other-start)
+            (setq mine-end   other-end)))
+
+          (let ((inhibit-read-only t)
+                (inhibit-modification-hooks t)
+                (m (buffer-modified-p)))
+            (unwind-protect
+                (add-text-properties start end smerge-text-properties)
+              (restore-buffer-modified-p m)))
+              
           (store-match-data (list start end
                                   mine-start mine-end
                                   base-start base-end