changed button-message to be sent on button-release
This commit is contained in:
parent
553fc1c5d5
commit
36da85834f
|
@ -3,7 +3,7 @@
|
||||||
(up-colors colors '("gray" "white" "black" "black"))
|
(up-colors colors '("gray" "white" "black" "black"))
|
||||||
(down-colors colors '("gray" "black" "white" "black"))
|
(down-colors colors '("gray" "black" "white" "black"))
|
||||||
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
(font font "-*-helvetica-medium-r-normal-*-12-*-*-*-*-*-*-*")
|
||||||
(content sexp 'none) ;; string | 'kill | 'iconize | 'maximize
|
(content sexp 'none) ;; string | 'kill | 'iconify | 'maximize
|
||||||
)
|
)
|
||||||
|
|
||||||
(define-record-type button :button
|
(define-record-type button :button
|
||||||
|
@ -49,10 +49,10 @@
|
||||||
(button-event-type e))
|
(button-event-type e))
|
||||||
(begin
|
(begin
|
||||||
(draw-button button gc 'down)
|
(draw-button button gc 'down)
|
||||||
(send out-channel (list message (button-event-time e)))
|
|
||||||
(loop 'down))
|
(loop 'down))
|
||||||
(begin
|
(begin
|
||||||
(draw-button button gc 'up)
|
(draw-button button gc 'up)
|
||||||
|
(send out-channel (list message (button-event-time e)))
|
||||||
(loop 'up))))
|
(loop 'up))))
|
||||||
(else (loop state)))))
|
(else (loop state)))))
|
||||||
(free-gc dpy gc)
|
(free-gc dpy gc)
|
||||||
|
@ -106,7 +106,7 @@
|
||||||
(foreground (fourth colors))))
|
(foreground (fourth colors))))
|
||||||
(draw-line dpy window gc bw bw (- ww (* 2 bw)) (- wh (* bw 2)))
|
(draw-line dpy window gc bw bw (- ww (* 2 bw)) (- wh (* bw 2)))
|
||||||
(draw-line dpy window gc bw (- wh (* bw 2)) (- ww (* bw 2)) bw))
|
(draw-line dpy window gc bw (- wh (* bw 2)) (- ww (* bw 2)) bw))
|
||||||
((iconize)
|
((iconify)
|
||||||
(change-gc dpy gc
|
(change-gc dpy gc
|
||||||
(make-gc-value-alist
|
(make-gc-value-alist
|
||||||
(line-width bw)
|
(line-width bw)
|
||||||
|
|
Loading…
Reference in New Issue