From 11ece56b1ab84d0ce8add8a1241ba7062e840860 Mon Sep 17 00:00:00 2001 From: Masatake YAMATO Date: Mon, 15 Mar 2004 11:27:47 +0000 Subject: [PATCH] 2004-03-15 Masatake YAMATO 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. --- lisp/ChangeLog | 18 ++++++++ lisp/smerge-mode.el | 110 +++++++++++++++++++++++++++++++++++++------- 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 + + 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 * 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 -;; 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 -- 2.39.2