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.

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 5a4799a913ff447e5f97dbe6fca7afdb555e3075..b9c938a089b6003ee621cb24cee63ce63a997017 100644 (file)
--- 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 711ceefedc0492dcf13d6ac68e91d447803e8cc1..742de9c2b96c5b519a801fbc60ddf6182d632c0f 100644 (file)
--- 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