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