From: Masatake YAMATO <jet@gyve.org>
Subject: Re: popup menu support for smerge-mode
Date: Thu, 11 Mar 2004 16:00:32 +0900 (JST) [thread overview]
Message-ID: <20040311.160032.38314964.jet@gyve.org> (raw)
In-Reply-To: <jwv8ynfliun.fsf-monnier+emacs/devel@vor.iro.umontreal.ca>
[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)
next prev parent reply other threads:[~2004-03-11 7:00 UTC|newest]
Thread overview: 20+ messages / expand[flat|nested] mbox.gz Atom feed top
2003-01-10 12:16 popup menu support for smerge-mode Masatake YAMATO
2003-01-11 19:41 ` Stefan Monnier
2003-08-24 6:03 ` Masatake YAMATO
2003-08-24 14:42 ` Stefan Monnier
2003-09-18 8:54 ` Masatake YAMATO
2003-09-18 15:27 ` Stefan Monnier
2003-09-19 9:25 ` Masatake YAMATO
2003-09-19 15:57 ` Stefan Monnier
2003-09-26 7:58 ` Masatake YAMATO
2003-09-26 8:44 ` Miles Bader
2003-09-26 8:53 ` Behavior of evaporate Masatake YAMATO
2003-09-26 9:05 ` Miles Bader
2003-09-26 9:17 ` David Kastrup
2003-09-26 15:59 ` Stefan Monnier
2003-09-27 2:31 ` Richard Stallman
2003-09-30 20:56 ` Alex Schroeder
2003-10-20 21:23 ` popup menu support for smerge-mode Stefan Monnier
2004-03-10 4:32 ` Masatake YAMATO
2004-03-11 7:00 ` Masatake YAMATO [this message]
2003-10-14 3:59 ` Masatake YAMATO
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=20040311.160032.38314964.jet@gyve.org \
--to=jet@gyve.org \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.