mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-12-26 10:49:33 +00:00
Code Issues Releases Activity

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

Browse Source 
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.
This commit is contained in:
Masatake YAMATO 2004-03-15 11:27:47 +00:00
parent 0eeebaf5d7
commit 11ece56b1a
2 changed files with 110 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
lisp/ChangeLog
View File

@ -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)

106
lisp/smerge-mode.el
View File

@ -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))
((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