Mercurial > emacs

--- a/lisp/ChangeLog	Mon Mar 15 08:39:06 2004 +0000
+++ b/lisp/ChangeLog	Mon Mar 15 11:27:47 2004 +0000
@@ -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)
--- a/lisp/smerge-mode.el	Mon Mar 15 08:39:06 2004 +0000
+++ b/lisp/smerge-mode.el	Mon Mar 15 11:27:47 2004 +0000
@@ -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 @@
      :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 @@
 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 @@
   (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 @@
   (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 @@
   (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 @@
   (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 @@
 	    (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))
+	   ((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)))
+	   ((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