mirror of
git://git.sv.gnu.org/emacs.git
synced 2026-02-16 17:24:23 +00:00
(smerge-refine-shadow-cursor): New variable and face (bug#78806)
* lisp/vc/smerge-mode.el (smerge-refine-shadow-cursor): New variable and face. (smerge-refine-regions): Add `cursor-sensor-functions` property to the covering overlays. (smerge--refine-at-right-margin-p, smerge--refine-shadow-cursor): New functions. (smerge--refine-other-pos): New function, extracted from `smerge-refine-exchange-point`. (smerge-refine-exchange-point): Use it. (smerge--refine-highlight-change): Add thin highlighted space for insertion/deletion positions. * lisp/emacs-lisp/cursor-sensor.el (cursor-sensor--detect): Run functions for `moved` events. Demote errors. (cursor-sensor-mode): Adjust docstring accordingly. * doc/lispref/text.texi (Special Properties) <cursor-sensor-functions>: Mention the new `moved` direction.
This commit is contained in:
Stefan Monnier
parent
e5ad9ae100
commit
08fba517f6
4 changed files with 184 additions and 90 deletions
|
|
@ -3986,10 +3986,13 @@ These properties are obsolete; please use
|
|||
This special property records a list of functions that react to cursor
|
||||
motion. Each function in the list is called, just before redisplay,
|
||||
with 3 arguments: the affected window, the previous known position of
|
||||
the cursor, and one of the symbols @code{entered} or @code{left},
|
||||
depending on whether the cursor is entering the text that has this
|
||||
property or leaving it. The functions are called only when the minor
|
||||
mode @code{cursor-sensor-mode} is turned on.
|
||||
the cursor, and a symbol indicating the direction of the movement.
|
||||
The movement can be @code{entered} or @code{left}, depending on whether
|
||||
the cursor is entering the text that has this property or leaving it, or
|
||||
@code{moved} when the cursor moved within that text.
|
||||
Other values for the direction should be ignored.
|
||||
The functions are called only when the minor mode
|
||||
@code{cursor-sensor-mode} is turned on.
|
||||
|
||||
When the variable @code{cursor-sensor-inhibit} is non-@code{nil}, the
|
||||
@code{cursor-sensor-functions} property is ignored.
|
||||
|
|
|
|||
15
etc/NEWS
15
etc/NEWS
|
|
@ -922,7 +922,8 @@ are discarded, which matches the behavior of physical terminals and other
|
|||
terminal emulators. Control sequences and escape sequences are still processed
|
||||
correctly regardless of margin position.
|
||||
|
||||
** Smerge
|
||||
---
|
||||
** SMerge
|
||||
|
||||
*** New command 'smerge-extend' extends a conflict over surrounding lines.
|
||||
|
||||
|
|
@ -931,6 +932,18 @@ When used inside a refined chunk, it jumps to the matching position in
|
|||
the "other" side of the refinement: if you're in the new text, it jumps
|
||||
to the corresponding position in the old text and vice versa.
|
||||
|
||||
*** New variable 'smerge-refine-shadow-cursor'.
|
||||
When 'smerge-refine' shows the conflict diffs at word granularity, a
|
||||
"shadow cursor" is now displayed in the "lower" version when point
|
||||
is in the "upper" version, and vice versa. The "shadow cursor" is
|
||||
just the character corresponding to the position where
|
||||
'smerge-refine-exchange-point' would jump, shown in a new distinct
|
||||
face 'smerge-refine-shadow-cursor', by default a box face.
|
||||
|
||||
** Cursor-Sensor mode
|
||||
+++
|
||||
*** New direction 'moved' used when the cursor moved within the active area.
|
||||
|
||||
** Image Dired
|
||||
|
||||
*** 'image-dired-show-all-from-dir' takes the same first argument as 'dired'.
|
||||
|
|
|
|||
|
|
@ -141,63 +141,69 @@ By convention, this is a list of symbols where each symbol stands for the
|
|||
;;; Detect cursor movement.
|
||||
|
||||
(defun cursor-sensor--detect (&optional window)
|
||||
(with-current-buffer (window-buffer window)
|
||||
(unless cursor-sensor-inhibit
|
||||
(let* ((point (window-point window))
|
||||
;; It's often desirable to make the
|
||||
;; cursor-sensor-functions property non-sticky on both
|
||||
;; ends, but that means get-pos-property might never
|
||||
;; see it.
|
||||
(new (or (get-char-property point 'cursor-sensor-functions)
|
||||
(unless (<= (point-min) point)
|
||||
(get-char-property (1- point)
|
||||
'cursor-sensor-functions))))
|
||||
(old (window-parameter window 'cursor-sensor--last-state))
|
||||
(oldposmark (car old))
|
||||
(oldpos (or (if oldposmark (marker-position oldposmark))
|
||||
(point-min)))
|
||||
(start (min oldpos point))
|
||||
(end (max oldpos point)))
|
||||
(unless (or (null old) (eq (marker-buffer oldposmark) (current-buffer)))
|
||||
;; `window' does not display the same buffer any more!
|
||||
(setcdr old nil))
|
||||
(if (or (and (null new) (null (cdr old)))
|
||||
(and (eq new (cdr old))
|
||||
(eq (next-single-char-property-change
|
||||
start 'cursor-sensor-functions nil end)
|
||||
end)))
|
||||
;; Clearly nothing to do.
|
||||
nil
|
||||
;; Maybe something to do. Let's see exactly what needs to run.
|
||||
(let* ((missing-p
|
||||
(lambda (f)
|
||||
"Non-nil if F is missing somewhere between START and END."
|
||||
(let ((pos start)
|
||||
(missing nil))
|
||||
(while (< pos end)
|
||||
(setq pos (next-single-char-property-change
|
||||
pos 'cursor-sensor-functions
|
||||
nil end))
|
||||
(unless (memq f (get-char-property
|
||||
pos 'cursor-sensor-functions))
|
||||
(setq missing t)))
|
||||
missing)))
|
||||
(window (selected-window)))
|
||||
(dolist (f (cdr old))
|
||||
(unless (and (memq f new) (not (funcall missing-p f)))
|
||||
(funcall f window oldpos 'left)))
|
||||
(dolist (f new)
|
||||
(unless (and (memq f (cdr old)) (not (funcall missing-p f)))
|
||||
(funcall f window oldpos 'entered)))))
|
||||
;; We're run from `pre-redisplay-functions' and `post-command-hook'
|
||||
;; where we can't handle errors very well, so just demote them to make
|
||||
;; sure they don't get in the way.
|
||||
(with-demoted-errors "cursor-sensor--detect: %S"
|
||||
(with-current-buffer (window-buffer window)
|
||||
(unless cursor-sensor-inhibit
|
||||
(let* ((point (window-point window))
|
||||
;; It's often desirable to make the
|
||||
;; cursor-sensor-functions property non-sticky on both
|
||||
;; ends, so we can't use `get-pos-property' because it
|
||||
;; might never see it.
|
||||
;; FIXME: Combine properties from covering overlays?
|
||||
(new (or (get-char-property point 'cursor-sensor-functions)
|
||||
(unless (<= (point-min) point)
|
||||
(get-char-property (1- point)
|
||||
'cursor-sensor-functions))))
|
||||
(old (window-parameter window 'cursor-sensor--last-state))
|
||||
(oldposmark (car old))
|
||||
(oldpos (or (if oldposmark (marker-position oldposmark))
|
||||
(point-min)))
|
||||
(start (min oldpos point))
|
||||
(end (max oldpos point)))
|
||||
(unless (or (null old)
|
||||
(eq (marker-buffer oldposmark) (current-buffer)))
|
||||
;; `window' does not display the same buffer any more!
|
||||
(setcdr old nil))
|
||||
(if (and (null new) (null (cdr old)))
|
||||
;; Clearly nothing to do.
|
||||
nil
|
||||
;; Maybe something to do. Let's see exactly what needs to run.
|
||||
(let* ((missing-p
|
||||
(lambda (f)
|
||||
"Non-nil if F is missing somewhere between START and END."
|
||||
(let ((pos start)
|
||||
(missing nil))
|
||||
(while (< pos end)
|
||||
(setq pos (next-single-char-property-change
|
||||
pos 'cursor-sensor-functions
|
||||
nil end))
|
||||
(unless (memq f (get-char-property
|
||||
pos 'cursor-sensor-functions))
|
||||
(setq missing t)))
|
||||
missing)))
|
||||
(window (selected-window)))
|
||||
(dolist (f (cdr old))
|
||||
(unless (and (memq f new) (not (funcall missing-p f)))
|
||||
(funcall f window oldpos 'left)))
|
||||
(dolist (f new)
|
||||
(let ((op (cond
|
||||
((or (not (memq f (cdr old))) (funcall missing-p f))
|
||||
'entered)
|
||||
((not (= start end)) 'moved))))
|
||||
(when op
|
||||
(funcall f window oldpos op))))))
|
||||
|
||||
;; Remember current state for next time.
|
||||
;; Re-read cursor-sensor-functions since the functions may have moved
|
||||
;; window-point!
|
||||
(if old
|
||||
(progn (move-marker (car old) point)
|
||||
(setcdr old new))
|
||||
(set-window-parameter window 'cursor-sensor--last-state
|
||||
(cons (copy-marker point) new)))))))
|
||||
;; Remember current state for next time.
|
||||
;; Re-read cursor-sensor-functions since the functions may have moved
|
||||
;; window-point!
|
||||
(if old
|
||||
(progn (move-marker (car old) point)
|
||||
(setcdr old new))
|
||||
(set-window-parameter window 'cursor-sensor--last-state
|
||||
(cons (copy-marker point) new))))))))
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode cursor-sensor-mode
|
||||
|
|
@ -205,8 +211,9 @@ By convention, this is a list of symbols where each symbol stands for the
|
|||
This property should hold a list of functions which react to the motion
|
||||
of the cursor. They're called with three arguments (WINDOW OLDPOS DIR)
|
||||
where WINDOW is the affected window, OLDPOS is the last known position of
|
||||
the cursor and DIR can be `entered' or `left' depending on whether the cursor
|
||||
is entering the area covered by the text-property property or leaving it."
|
||||
the cursor and DIR can be `entered', `left', or `moved' depending on whether
|
||||
the cursor is entering the area covered by the text-property property,
|
||||
leaving it, or just moving inside of it."
|
||||
:global nil
|
||||
(cond
|
||||
(cursor-sensor-mode
|
||||
|
|
|
|||
|
|
@ -1089,12 +1089,28 @@ chars to try and eliminate some spurious differences."
|
|||
;; (list match-num1 match-num2 startline))
|
||||
(overlay-put ol 'evaporate t)
|
||||
(dolist (x props)
|
||||
(when (or (> end beg)
|
||||
;; Don't highlight the char we cover artificially.
|
||||
(not (memq (car-safe x) '(face font-lock-face))))
|
||||
(overlay-put ol (car x) (cdr x))))
|
||||
(if (or (> end beg)
|
||||
(not (memq (car-safe x) '(face font-lock-face))))
|
||||
(overlay-put ol (car x) (cdr x))
|
||||
;; Don't highlight the char we cover artificially.
|
||||
(overlay-put ol (if (= beg olbeg) 'before-string 'after-string)
|
||||
(propertize
|
||||
" " (car-safe x) (cdr-safe x)
|
||||
'display '(space :width 0.5)))))
|
||||
ol)))))
|
||||
|
||||
(defcustom smerge-refine-shadow-cursor t
|
||||
"If non-nil, display a shadow cursor on the other side of smerge refined regions.
|
||||
Its appearance is controlled by the face `smerge-refine-shadow-cursor'."
|
||||
:type 'boolean
|
||||
:version "31.1")
|
||||
|
||||
(defface smerge-refine-shadow-cursor
|
||||
'((t :box (:line-width (-2 . -2))))
|
||||
"Face placed on a character to highlight it as the shadow cursor.
|
||||
The presence of the shadow cursor depends on the
|
||||
variable `smerge-refine-shadow-cursor'.")
|
||||
|
||||
;;;###autoload
|
||||
(defun smerge-refine-regions (beg1 end1 beg2 end2 props-c &optional preproc props-r props-a)
|
||||
"Show fine differences in the two regions BEG1..END1 and BEG2..END2.
|
||||
|
|
@ -1124,7 +1140,11 @@ used to replace chars to try and eliminate some spurious differences."
|
|||
(ol2 (make-overlay beg2 end2 nil
|
||||
;; Make it shrink rather than spread when editing.
|
||||
'front-advance nil))
|
||||
(common-props '((evaporate . t) (smerge--refine-region . t))))
|
||||
(common-props '((evaporate . t) (smerge--refine-region . t)
|
||||
(cursor-sensor-functions
|
||||
smerge--refine-shadow-cursor))))
|
||||
(when smerge-refine-shadow-cursor
|
||||
(cursor-sensor-mode 1))
|
||||
(dolist (prop (or props-a props-c))
|
||||
(when (and (not (memq (car prop) '(face font-lock-face)))
|
||||
(member prop (or props-r props-c))
|
||||
|
|
@ -1215,6 +1235,55 @@ used to replace chars to try and eliminate some spurious differences."
|
|||
(define-obsolete-function-alias 'smerge-refine-subst
|
||||
#'smerge-refine-regions "26.1")
|
||||
|
||||
(defun smerge--refine-at-right-margin-p (pos window)
|
||||
;; FIXME: `posn-at-point' seems to be costly/slow.
|
||||
(when-let* ((posn (posn-at-point pos window))
|
||||
(xy (nth 2 posn))
|
||||
(x (car-safe xy))
|
||||
(_ (numberp x)))
|
||||
(> (+ x (with-selected-window window (string-pixel-width " ")))
|
||||
(car (window-text-pixel-size window)))))
|
||||
|
||||
(defun smerge--refine-shadow-cursor (window _oldpos dir)
|
||||
(let ((ol (window-parameter window 'smerge--refine-shadow-cursor)))
|
||||
(if (not (and smerge-refine-shadow-cursor
|
||||
(memq dir '(entered moved))))
|
||||
(if ol (delete-overlay ol))
|
||||
(with-current-buffer (window-buffer window)
|
||||
(let* ((cursor (window-point window))
|
||||
(other-beg (ignore-errors (smerge--refine-other-pos cursor))))
|
||||
(if (not other-beg)
|
||||
(if ol (delete-overlay ol))
|
||||
(let ((other-end (min (point-max) (1+ other-beg))))
|
||||
;; If other-beg/end covers a "wide" char like TAB or LF, the
|
||||
;; resulting shadow cursor doesn't look like a cursor, so try
|
||||
;; and convert it to a before-string space.
|
||||
(when (or (and (eq ?\n (char-after other-beg))
|
||||
(not (smerge--refine-at-right-margin-p
|
||||
other-beg window)))
|
||||
(and (eq ?\t (char-after other-beg))
|
||||
;; FIXME: `posn-at-point' seems to be costly/slow.
|
||||
(when-let* ((posn (posn-at-point other-beg window))
|
||||
(xy (nth 2 posn))
|
||||
(x (car-safe xy))
|
||||
(_ (numberp x)))
|
||||
(< (1+ (% x tab-width)) tab-width))))
|
||||
(setq other-end other-beg))
|
||||
;; FIXME: Doesn't obey `cursor-in-non-selected-windows'.
|
||||
(if ol (move-overlay ol other-beg other-end)
|
||||
(setq ol (make-overlay other-beg other-end nil t nil))
|
||||
(setf (window-parameter window 'smerge--refine-shadow-cursor)
|
||||
ol)
|
||||
(overlay-put ol 'window window)
|
||||
(overlay-put ol 'face 'smerge-refine-shadow-cursor))
|
||||
;; When the shadow cursor needs to be at EOB (or TAB or EOL),
|
||||
;; "draw" it as a pseudo space character.
|
||||
(overlay-put ol 'before-string
|
||||
(when (= other-beg other-end)
|
||||
(eval-when-compile
|
||||
(propertize
|
||||
" " 'face 'smerge-refine-shadow-cursor)))))))))))
|
||||
|
||||
(defun smerge-refine (&optional part)
|
||||
"Highlight the words of the conflict that are different.
|
||||
For 3-way conflicts, highlights only two of the three parts.
|
||||
|
|
@ -1265,56 +1334,58 @@ repeating the command will highlight other two parts."
|
|||
(unless smerge-use-changed-face
|
||||
'((smerge . refine) (font-lock-face . smerge-refined-added))))))
|
||||
|
||||
(defun smerge-refine-exchange-point ()
|
||||
"Go to the matching position in the other chunk."
|
||||
(interactive)
|
||||
(defun smerge--refine-other-pos (pos)
|
||||
(let* ((covering-ol
|
||||
(let ((ols (overlays-at (point))))
|
||||
(let ((ols (overlays-at pos)))
|
||||
(while (and ols (not (overlay-get (car ols)
|
||||
'smerge--refine-region)))
|
||||
(pop ols))
|
||||
(or (car ols)
|
||||
(user-error "Not inside a refined region"))))
|
||||
(ref-pos
|
||||
(if (or (get-char-property (point) 'smerge--refine-other)
|
||||
(get-char-property (1- (point)) 'smerge--refine-other))
|
||||
(point)
|
||||
(if (or (get-char-property pos 'smerge--refine-other)
|
||||
(get-char-property (1- pos) 'smerge--refine-other))
|
||||
pos
|
||||
(let ((next (next-single-char-property-change
|
||||
(point) 'smerge--refine-other nil
|
||||
pos 'smerge--refine-other nil
|
||||
(overlay-end covering-ol)))
|
||||
(prev (previous-single-char-property-change
|
||||
(point) 'smerge--refine-other nil
|
||||
pos 'smerge--refine-other nil
|
||||
(overlay-start covering-ol))))
|
||||
(cond
|
||||
((and (> prev (overlay-start covering-ol))
|
||||
(or (>= next (overlay-end covering-ol))
|
||||
(> (- next (point)) (- (point) prev))))
|
||||
(> (- next pos) (- pos prev))))
|
||||
prev)
|
||||
((< next (overlay-end covering-ol)) next)
|
||||
(t (user-error "No \"other\" position info found"))))))
|
||||
(boundary
|
||||
(cond
|
||||
((< ref-pos (point))
|
||||
((< ref-pos pos)
|
||||
(let ((adjust (get-char-property (1- ref-pos)
|
||||
'smerge--refine-adjust)))
|
||||
(min (point) (+ ref-pos (or (cdr adjust) 0)))))
|
||||
((> ref-pos (point))
|
||||
(min pos (+ ref-pos (or (cdr adjust) 0)))))
|
||||
((> ref-pos pos)
|
||||
(let ((adjust (get-char-property ref-pos 'smerge--refine-adjust)))
|
||||
(max (point) (- ref-pos (or (car adjust) 0)))))
|
||||
(max pos (- ref-pos (or (car adjust) 0)))))
|
||||
(t ref-pos)))
|
||||
(other-forw (get-char-property ref-pos 'smerge--refine-other))
|
||||
(other-back (get-char-property (1- ref-pos) 'smerge--refine-other))
|
||||
(other (or other-forw other-back))
|
||||
(dist (- boundary (point))))
|
||||
(dist (- boundary pos)))
|
||||
(if (not (overlay-start other))
|
||||
(user-error "The \"other\" position has vanished")
|
||||
(goto-char
|
||||
(- (if other-forw
|
||||
(- (overlay-start other)
|
||||
(or (car (overlay-get other 'smerge--refine-adjust)) 0))
|
||||
(+ (overlay-end other)
|
||||
(or (cdr (overlay-get other 'smerge--refine-adjust)) 0)))
|
||||
dist)))))
|
||||
(- (if other-forw
|
||||
(- (overlay-start other)
|
||||
(or (car (overlay-get other 'smerge--refine-adjust)) 0))
|
||||
(+ (overlay-end other)
|
||||
(or (cdr (overlay-get other 'smerge--refine-adjust)) 0)))
|
||||
dist))))
|
||||
|
||||
(defun smerge-refine-exchange-point ()
|
||||
"Go to the matching position in the other chunk."
|
||||
(interactive)
|
||||
(goto-char (smerge--refine-other-pos (point))))
|
||||
|
||||
(defun smerge-swap ()
|
||||
;; FIXME: Extend for diff3 to allow swapping the middle end as well.
|
||||
|
|
|
|||
Loading…
Reference in a new issue