From mboxrd@z Thu Jan 1 00:00:00 1970 Path: main.gmane.org!not-for-mail From: Masatake YAMATO Newsgroups: gmane.emacs.devel Subject: Re: popup menu support for smerge-mode Date: Thu, 11 Mar 2004 16:00:32 +0900 (JST) Sender: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Message-ID: <20040311.160032.38314964.jet@gyve.org> References: <20030926.165808.260114910.jet@gyve.org> NNTP-Posting-Host: deer.gmane.org Mime-Version: 1.0 Content-Type: Text/Plain; charset=us-ascii Content-Transfer-Encoding: 7bit X-Trace: sea.gmane.org 1079229843 28837 80.91.224.253 (14 Mar 2004 02:04:03 GMT) X-Complaints-To: usenet@sea.gmane.org NNTP-Posting-Date: Sun, 14 Mar 2004 02:04:03 +0000 (UTC) Original-X-From: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Sun Mar 14 03:03:56 2004 Return-path: Original-Received: from quimby.gnus.org ([80.91.224.244]) by deer.gmane.org with esmtp (Exim 3.35 #1 (Debian)) id 1B2Kyq-0006hm-00 for ; Sun, 14 Mar 2004 03:03:56 +0100 Original-Received: from monty-python.gnu.org ([199.232.76.173]) by quimby.gnus.org with esmtp (Exim 3.35 #1 (Debian)) id 1B2Kyp-00071j-00 for ; Sun, 14 Mar 2004 03:03:55 +0100 Original-Received: from localhost ([127.0.0.1] helo=monty-python.gnu.org) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B2Kwx-0008Qj-Ka for emacs-devel@quimby.gnus.org; Sat, 13 Mar 2004 21:01:59 -0500 Original-Received: from list by monty-python.gnu.org with tmda-scanned (Exim 4.30) id 1B2JrN-0006jB-99 for emacs-devel@gnu.org; Sat, 13 Mar 2004 19:52:09 -0500 Original-Received: from mail by monty-python.gnu.org with spam-scanned (Exim 4.30) id 1B1KBN-0002Jh-NH for emacs-devel@gnu.org; Thu, 11 Mar 2004 02:01:12 -0500 Original-Received: from [210.130.136.40] (helo=r-maa.spacetown.ne.jp) by monty-python.gnu.org with esmtp (Exim 4.30) id 1B1KBM-0002IS-7a for emacs-devel@gnu.org; Thu, 11 Mar 2004 02:00:40 -0500 Original-Received: from localhost (nat-pool.jp.redhat.com [219.120.63.249]) by r-maa.spacetown.ne.jp (8.11.6) with ESMTP id i2B70Wn13295 for ; Thu, 11 Mar 2004 16:00:32 +0900 (JST) Original-To: emacs-devel@gnu.org In-Reply-To: X-Mailer: Mew version 4.0.62 on Emacs 21.3.50 / Mule 5.0 (SAKAKI) X-BeenThere: emacs-devel@gnu.org X-Mailman-Version: 2.1.4 Precedence: list List-Id: "Emacs development discussions." List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: emacs-devel-bounces+emacs-devel=quimby.gnus.org@gnu.org Xref: main.gmane.org gmane.emacs.devel:20424 X-Report-Spam: http://spam.gmane.org/gmane.emacs.devel:20424 [resending] I've found a time to revise my patch about popup menu support for smerge-mode. Stefan, don't angry with me. I hope you do not forget the old patch... A patch for popup menu for smerge-mode in my local machine is too useful to me to throw away:-) > > mine and other uses special menus. I added "Keep alternative" to the > > menus. Other including whole uses the smerge menu appeared on the > > menu bar. > > Don't forget that conflicts can have a 3-parts shape where there's not just > "mine" and "other" but also the ancestor, in which case there's no single > "Keep alternative". I've added "Revert to the BASE" to the popup menu. > > +(easy-menu-define smerge-mode-mine-popup-menu nil > > + "Popup menu for mine area in `smerge-mode'." > > + '(nil > > + ["Keep This" smerge-keep-current :help "Use current (at point) version"] > > + ;; mine <-> other > > + ["Keep Alternative" smerge-keep-other :help "Use alternative version"] > > + ["Keep All" smerge-keep-all :help "Keep all three versions"] > > + "---" > > + ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode menu"] > > + )) > > +(easy-menu-define smerge-mode-other-popup-menu nil > > + "Popup menu for other area in `smerge-mode'." > > + '(nil > > + ["Keep This" smerge-keep-current :help "Use current (at point) version"] > > + ;; other <-> mine > > + ["Keep Alternative" smerge-keep-mine :help "Use alternative version"] > > + ["Keep All" smerge-keep-all :help "Keep all three versions"] > > + "---" > > + ["More..." (popup-menu smerge-mode-menu) :help "Show full SMerge mode menu"] > > + )) > > I'd rather introduce a new function smerge-keep-alternative which > will determine whether to use `other' or `mine' depending on `current'. > This way there's only one menu rather than two with the same appearance > but different behavior. I wrote `smerge-keep-alternative' and unified the above two menus. > > + (when (and b e (not (= b e))) > > I think this can be simplified to `unless (eq e b)' because `e' and `b' > are either both locations or both nil. I have used `unless'. > > + ;; Delete overlays > > + (when (or > > + (not (overlay-buffer o-whole)) ;; dead > > + (< (- (overlay-end o-whole) (overlay-start o-whole)) > > + region-whole)) ;; shrinked up > > + (mapc 'delete-overlay (cons o-whole os-sub))))))) > > I agree it's easier to remove the overlays from smerge-activate-popup-menu, > but that means they'll just never be removed if the user doesn't use > this new feature. I think it really needs to be done somewhere else > instead (E.g. at the same place as the auto-leave code is run. We'll > probably need to introduce a new function `smerge-post-resolution-update' > which will do the auto-leave check and will remove the overlays). Removing overlays in smerge-post-resolution-update(or auto-leave) is not easy because the some part of text area associated with the overlays are removed during "resolution". Instead I put the code(smerge-delete-overlays-at) to delete overlays before "resolution". Index: lisp/smerge-mode.el =================================================================== RCS file: /cvsroot/emacs/emacs/lisp/smerge-mode.el,v retrieving revision 1.24 diff -u -r1.24 smerge-mode.el --- lisp/smerge-mode.el 6 Oct 2003 16:34:59 -0000 1.24 +++ lisp/smerge-mode.el 10 Mar 2004 04:27:49 -0000 @@ -159,6 +159,22 @@ :help "Use Ediff to resolve the conflicts"] )) +(defvar smerge-overlays nil "Overlays managed by smerge-mode") +(easy-mmode-defmap smerge-popup-menu-map + `(([down-mouse-3] . smerge-activate-popup-menu)) + "Keymap for popup menu appeared on conflicts area.") +(easy-menu-define smerge-mode-popup-menu nil + "Popup menu for mine area in `smerge-mode'." + '(nil + ["Keep All" smerge-keep-all :help "Keep all three versions"] + ["Revert to the Base" smerge-keep-base :help "Revert to the base version"] + ["Keep This" smerge-keep-current :help "Use current (at point) version"] + ["Keep Alternative" smerge-keep-alternative :help "Use alternative version"] + "---" + ["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) @@ -198,18 +214,35 @@ (unless (match-end n) (error (format "No `%s'" (aref smerge-match-names n))))) +(defun smerge-delete-overlays-at (pos) + "Delete overlays used in Smerge mode under POS." + (let ((overlays (overlays-at pos)) + o + suboverlays) + (while overlays + (setq o (car overlays) + overlays (cdr overlays) + suboverlays (overlay-get o 'suboverlays)) + (when suboverlays + (setq suboverlays (cons o suboverlays) + overlays nil))) + (mapc 'delete-overlay suboverlays))) + (defun smerge-auto-leave () + "If no conflict left, turn off Smerge mode. +Return non-nil if the mode was indeed turned off." (when (and smerge-auto-leave (save-excursion (goto-char (point-min)) (not (re-search-forward smerge-begin-re nil t)))) - (smerge-mode -1))) - + (smerge-mode -1) + t)) (defun smerge-keep-all () "Keep all three versions. Convenient for the kind of conflicts that can arise in ChangeLog files." (interactive) (smerge-match-conflict) + (smerge-delete-overlays-at (point)) (replace-match (concat (or (match-string 1) "") (or (match-string 2) "") (or (match-string 3) "")) @@ -261,6 +294,7 @@ some major modes. Uses `smerge-resolve-function' to do the actual work." (interactive) (smerge-match-conflict) + (smerge-delete-overlays-at (point)) (funcall smerge-resolve-function) (smerge-auto-leave)) @@ -269,6 +303,7 @@ (interactive) (smerge-match-conflict) (smerge-ensure-match 2) + (smerge-delete-overlays-at (point)) (replace-match (match-string 2) t t) (smerge-auto-leave)) @@ -277,6 +312,7 @@ (interactive) (smerge-match-conflict) ;;(smerge-ensure-match 3) + (smerge-delete-overlays-at (point)) (replace-match (match-string 3) t t) (smerge-auto-leave)) @@ -285,6 +321,7 @@ (interactive) (smerge-match-conflict) ;;(smerge-ensure-match 1) + (smerge-delete-overlays-at (point)) (replace-match (match-string 1) t t) (smerge-auto-leave)) @@ -298,9 +335,28 @@ (>= (point) (match-end i))) (decf i)) (if (<= i 0) (error "Not inside a version") + (smerge-delete-overlays-at (point)) (replace-match (match-string i) t t) (smerge-auto-leave)))) +(defun smerge-keep-alternative () + "Use the alternatives (not under the cursor) version." + (interactive) + (smerge-match-conflict) + (let ((i 3)) + (while (or (not (match-end i)) + (< (point) (match-beginning i)) + (>= (point) (match-end i))) + (decf i)) + (cond + ((<= i 0) (error "Not inside a version")) + ((eq i 2) (error "No alternative for the base version")) + ((eq i 3) (setq i 1)) + ((eq i 1) (setq i 3))) + (smerge-delete-overlays-at (point)) + (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) @@ -316,6 +372,93 @@ (interactive) (smerge-diff 1 3)) +(defun smerge-put-overlays (match-data) + "Put overlays of smerge-mode on the place specified by MATCH-DATA." + (let ((m (cddr match-data)) + (owners '(mine base other base-start other-start)) + (b-whole (car match-data)) + (e-whole (cadr match-data)) + b e o os) + (while m + (setq b (car m) + e (cadr m) + m (cddr m) + o (car owners) + owners (cdr owners)) + (unless (eq e b) + (push (smerge-put-highlight-overlay b e o) + os))) + ;; highlight overlays are managed by keymap overlay. + ;; When keymap overlay is shrinked or removed, + ;; highlight overlays are removed. + (smerge-put-keymap-overlay b-whole e-whole os))) + +(defun smerge-put-highlight-overlay (start end owner) + "Put overlay of smerge-mode between START and END. +The overlay is highlight when it is pressed. +OWNER is stored to `owner' property of the new overlay." + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'owner owner) + (push overlay smerge-overlays) + overlay)) + +(defun smerge-put-keymap-overlay (start end suboverlays) + "Put overlay of smerge-mode between START and END. +The overlay has its own keymap to show popup menu. +SUBOVERLAYS are overlays managed by this overlay." + (let ((overlay (make-overlay start end))) + (overlay-put overlay 'evaporate t) + (overlay-put overlay 'help-echo "down-mouse-3: Show popup menu") + (overlay-put overlay 'local-map smerge-popup-menu-map) + (overlay-put overlay 'owner 'whole) + (overlay-put overlay 'suboverlays suboverlays) + (push overlay smerge-overlays) + overlay)) + +(defun smerge-activate-popup-menu (event) + "Show a popup menu for smerge-mode." + (interactive "e") + (with-current-buffer (window-buffer + (posn-window (event-end event))) + (save-excursion + (goto-char (posn-point (event-end event))) + (let ((overlays (overlays-at (point))) + overlay + face menu) + (while overlays + (let* ((o (car overlays)) + (owner (overlay-get o 'owner))) + ;; Find mine or other. If such owner is found, + ;; we can overwrite `overlay' local variable. + (cond + ((or (eq 'mine owner) (eq 'other owner)) + (setq overlay o + face 'region + menu smerge-mode-popup-menu + overlays nil)) + ;; Find whole. If such owner is found. + ;; we can set `overlay' local variable + ;;if overlay is not set yet. + ((and (eq 'whole owner) (not overlay)) + (setq overlay o + face 'highlight + menu smerge-mode-menu)) + (t + (setq overlays (cdr overlays)))))) + (unwind-protect + (progn + (overlay-put overlay 'face face) + (sit-for 0) ;; redisplay + (popup-menu menu)) + (overlay-put overlay 'face nil)))))) + + +(defun smerge-delete-all-overlays () + "Delete all overlays made by `smerge-put-overlay'." + (mapc 'delete-overlay smerge-overlays) + (setq smerge-overlays nil)) + (defun smerge-match-conflict () "Get info about the conflict. Puts the info in the `match-data'. The submatches contain: @@ -522,6 +665,12 @@ "Minor mode to simplify editing output from the diff3 program. \\{smerge-mode-map}" nil " SMerge" nil + ;; overlays management + (if smerge-mode + ;; entering smerge-mode + (make-variable-buffer-local 'smerge-overlays) + ;; leaving smerge-mode + (smerge-delete-all-overlays)) (when (and (boundp 'font-lock-mode) font-lock-mode) (set (make-local-variable 'font-lock-multiline) t) (save-excursion @@ -531,8 +680,8 @@ (goto-char (point-min)) (while (smerge-find-conflict) (save-excursion - (font-lock-fontify-region (match-beginning 0) (match-end 0) nil)))))) - + (font-lock-fontify-region (match-beginning 0) (match-end 0) nil) + (smerge-put-overlays (match-data))))))) (provide 'smerge-mode)