delayed dragging with a timer, to prevent the window from 'hanging

behind the cursor'
This commit is contained in:
frese 2003-04-15 15:53:57 +00:00
parent 8918c6f7ff
commit 6b10b56ccf
1 changed files with 41 additions and 28 deletions

View File

@ -107,32 +107,45 @@
(drag (drag
(lambda (dwin click-x click-y win-x win-y) (lambda (dwin click-x click-y win-x win-y)
(let ((xevent (receive event-channel))) (let loop ((move-timer #f))
(cond (select
((eq? (event-type button-release) (cons
(any-event-type xevent)) (wrap (receive-rv event-channel)
(let ((x (+ (window-x dpy dragged-window) (lambda (xevent)
(- (button-event-x xevent) (cond
click-x))) ((eq? (event-type button-release)
(y (+ (window-y dpy dragged-window) (any-event-type xevent))
(- (button-event-y xevent) (let ((x (+ (window-x dpy dragged-window)
click-y)))) (- (button-event-x xevent)
(destroy-drag-window dwin) click-x)))
(send channel (list 'drop x y (y (+ (window-y dpy dragged-window)
(button-event-x-root xevent) (- (button-event-y xevent)
(button-event-y-root xevent))) click-y))))
;;(ungrab-server dpy) (destroy-drag-window dwin)
(idle))) (send channel
(list 'drop x y
((motion-event? xevent) (button-event-x-root xevent)
(let ((x (motion-event-x xevent)) (button-event-y-root xevent)))
(y (motion-event-y xevent))) ;;(ungrab-server dpy)
(move-drag-window dwin (idle)))
(+ win-x (- x click-x))
(+ win-y (- y click-y))) ((motion-event? xevent)
(drag dwin click-x click-y win-x win-y))) (let ((x (motion-event-x xevent))
(y (motion-event-y xevent)))
((destroy-window-event? xevent) #t) (loop (list 0.2
(else (+ win-x (- x click-x))
(drag dwin click-x click-y win-x win-y))))))) (+ win-y (- y click-y))))))
((destroy-window-event? xevent) #t)
(else (loop move-timer)))))
(if move-timer
(list
(wrap (after-time-rv (first move-timer))
(lambda (_)
(move-drag-window dwin
(second move-timer)
(third move-timer))
(loop #f))))
'()))))))
)
(idle))))))) (idle)))))))