scsh-conservatory
/
orion-wm
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
src/drag-window.scm
View File

@ -107,7 +107,11 @@
(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))
(select
(cons
(wrap (receive-rv event-channel)
(lambda (xevent)
(cond (cond
((eq? (event-type button-release) ((eq? (event-type button-release)
(any-event-type xevent)) (any-event-type xevent))
@ -118,7 +122,8 @@
(- (button-event-y xevent) (- (button-event-y xevent)
click-y)))) click-y))))
(destroy-drag-window dwin) (destroy-drag-window dwin)
(send channel (list 'drop x y (send channel
(list 'drop x y
(button-event-x-root xevent) (button-event-x-root xevent)
(button-event-y-root xevent))) (button-event-y-root xevent)))
;;(ungrab-server dpy) ;;(ungrab-server dpy)
@ -127,12 +132,20 @@
((motion-event? xevent) ((motion-event? xevent)
(let ((x (motion-event-x xevent)) (let ((x (motion-event-x xevent))
(y (motion-event-y xevent))) (y (motion-event-y xevent)))
(move-drag-window dwin (loop (list 0.2
(+ win-x (- x click-x)) (+ win-x (- x click-x))
(+ win-y (- y click-y))) (+ win-y (- y click-y))))))
(drag dwin click-x click-y win-x win-y)))
((destroy-window-event? xevent) #t) ((destroy-window-event? xevent) #t)
(else (else (loop move-timer)))))
(drag dwin click-x click-y win-x win-y))))))) (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)))))))