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
(lambda (dwin click-x click-y win-x win-y)
(let ((xevent (receive event-channel)))
(cond
((eq? (event-type button-release)
(any-event-type xevent))
(let ((x (+ (window-x dpy dragged-window)
(- (button-event-x xevent)
click-x)))
(y (+ (window-y dpy dragged-window)
(- (button-event-y xevent)
click-y))))
(destroy-drag-window dwin)
(send channel (list 'drop x y
(button-event-x-root xevent)
(button-event-y-root xevent)))
;;(ungrab-server dpy)
(idle)))
((motion-event? xevent)
(let ((x (motion-event-x xevent))
(y (motion-event-y xevent)))
(move-drag-window dwin
(+ win-x (- x click-x))
(+ win-y (- y click-y)))
(drag dwin click-x click-y win-x win-y)))
((destroy-window-event? xevent) #t)
(else
(drag dwin click-x click-y win-x win-y)))))))
(let loop ((move-timer #f))
(select
(cons
(wrap (receive-rv event-channel)
(lambda (xevent)
(cond
((eq? (event-type button-release)
(any-event-type xevent))
(let ((x (+ (window-x dpy dragged-window)
(- (button-event-x xevent)
click-x)))
(y (+ (window-y dpy dragged-window)
(- (button-event-y xevent)
click-y))))
(destroy-drag-window dwin)
(send channel
(list 'drop x y
(button-event-x-root xevent)
(button-event-y-root xevent)))
;;(ungrab-server dpy)
(idle)))
((motion-event? xevent)
(let ((x (motion-event-x xevent))
(y (motion-event-y xevent)))
(loop (list 0.2
(+ win-x (- x click-x))
(+ 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)))))))