comparison lisp/smerge-mode.el @ 54402:8bf3846fc7dd

2004-03-15 Masatake YAMATO <[e-mail]> 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.

54401:7f6dab15e141

;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts

;; Copyright (C) 1999, 2000, 01, 03, 2004  Free Software Foundation, Inc.

;; Author: Stefan Monnier <[e-mail]>
;; Keywords: merge diff3 cvs conflict
;; Revision: $Id: smerge-mode.el,v 1.24 2003/10/06 16:34:59 fx Exp $

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

    ["Combine" smerge-combine-with-next
     :help "Combine current conflict with next"
     :active (smerge-check 1)]
    ))

(defconst smerge-font-lock-keywords
  '((smerge-find-conflict
     (1 smerge-mine-face prepend t)
     (2 smerge-base-face prepend t)
     (3 smerge-other-face prepend t)

  (lambda () (error "Don't know how to resolve"))
  "Mode-specific merge function.
The function is called with no argument and with the match data set
according to `smerge-match-conflict'.")

(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)
  (funcall smerge-resolve-function)
  (smerge-auto-leave))

(defun smerge-keep-base ()
  "Revert to the base version."
  (interactive)
  (smerge-match-conflict)
  (smerge-ensure-match 2)
  (replace-match (match-string 2) t t)
  (smerge-auto-leave))

(defun smerge-keep-other ()
  "Use \"other\" version."
  (interactive)
  (smerge-match-conflict)
  ;;(smerge-ensure-match 3)
  (replace-match (match-string 3) t t)
  (smerge-auto-leave))

(defun smerge-keep-mine ()
  "Keep your version."
  (interactive)
  (smerge-match-conflict)
  ;;(smerge-ensure-match 1)
  (replace-match (match-string 1) t t)
  (smerge-auto-leave))

(defun smerge-get-current ()
  (let ((i 3))

  "Use the current (under the cursor) version."
  (interactive)
  (smerge-match-conflict)
  (let ((i (smerge-get-current)))
    (if (<= i 0) (error "Not inside a version")
      (replace-match (match-string i) t t)
      (smerge-auto-leave))))

(defun smerge-diff-base-mine ()
  "Diff 'base' and 'mine' version in current conflict region."
  (interactive)

	    (set (make-local-variable 'smerge-conflict-style) 'diff3-A)
	    (setq base-end mine-end)
	    (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)))

	  (store-match-data (list start end
				  mine-start mine-end
				  base-start base-end
				  other-start other-end
				  (when base-start (1- base-start)) base-start

54402:8bf3846fc7dd

;;; smerge-mode.el --- Minor mode to resolve diff3 conflicts

;; Copyright (C) 1999, 2000, 01, 03, 2004  Free Software Foundation, Inc.

;; Author: Stefan Monnier <[e-mail]>
;; Keywords: revision-control merge diff3 cvs conflict

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by

    ["Combine" smerge-combine-with-next
     :help "Combine current conflict with next"
     :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)
     (2 smerge-base-face prepend t)
     (3 smerge-other-face prepend t)

  (lambda () (error "Don't know how to resolve"))
  "Mode-specific merge function.
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))

(defun smerge-keep-base ()
  "Revert to the base version."
  (interactive)
  (smerge-match-conflict)
  (smerge-ensure-match 2)
  (smerge-remove-props)
  (replace-match (match-string 2) t t)
  (smerge-auto-leave))

(defun smerge-keep-other ()
  "Use \"other\" version."
  (interactive)
  (smerge-match-conflict)
  ;;(smerge-ensure-match 3)
  (smerge-remove-props)
  (replace-match (match-string 3) t t)
  (smerge-auto-leave))

(defun smerge-keep-mine ()
  "Keep your version."
  (interactive)
  (smerge-match-conflict)
  ;;(smerge-ensure-match 1)
  (smerge-remove-props)
  (replace-match (match-string 1) t t)
  (smerge-auto-leave))

(defun smerge-get-current ()
  (let ((i 3))

  "Use 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 (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)

	    (set (make-local-variable 'smerge-conflict-style) 'diff3-A)
	    (setq base-end mine-end)
	    (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)
		     (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
				  other-start other-end
				  (when base-start (1- base-start)) base-start