suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

radio-box and transparent canvas repairs

Browse Source
This commit is contained in:
Matthew Flatt 2010-07-28 12:04:15 -05:00
parent 7de0f66b97
commit 4628ab4db8
4 changed files with 28 additions and 10 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/mred/private/wx/cocoa/canvas.rkt
View File

@ -331,7 +331,9 @@
1)]))
(define bg-col (make-object color% "white"))
(define/public (get-canvas-background) bg-col)
(define/public (get-canvas-background) (if (memq 'transparent canvas-style)
#f
bg-col))
(define/public (set-canvas-background col) (set! bg-col col))
(define/public (get-canvas-background-for-clearing)
(if now-drawing?

11
collects/mred/private/wx/cocoa/radio-box.rkt
View File

@ -21,6 +21,7 @@
(import-class NSMatrix NSButtonCell)
(define NSRadioModeMatrix 0)
(define NSListModeMatrix 2)
(define-objc-class MyMatrix NSMatrix
#:mixins (FocusResponder)
@ -115,8 +116,14 @@
(set-focus)))
(define/public (set-selection i)
(tellv (get-cocoa) selectCellAtRow: #:type _NSInteger (if horiz? 0 i)
column: #:type _NSInteger (if horiz? i 0)))
(if (= i -1)
(begin
;; Need to change to NSListModeMatrix to disable all.
;; It seem that we don't have to change the mode back, for some reason.
(tellv (get-cocoa) setMode: #:type _int NSListModeMatrix)
(tellv (get-cocoa) deselectAllCells))
(tellv (get-cocoa) selectCellAtRow: #:type _NSInteger (if horiz? 0 i)
column: #:type _NSInteger (if horiz? i 0))))
(define/public (get-selection)
(if horiz?
(tell #:type _NSInteger (get-cocoa) selectedColumn)

6
collects/mred/private/wx/gtk/canvas.rkt
View File

@ -267,9 +267,13 @@
(define clear-bg?
(and (not (memq 'transparent style))
(not (memq 'no-autoclear style))))
(define transparent?
(memq 'transparent style))
(define gc #f)
(define bg-col (make-object color% "white"))
(define/public (get-canvas-background) bg-col)
(define/public (get-canvas-background) (if transparent?
#f
bg-col))
(define/public (set-canvas-background col) (set! bg-col col))
(define/public (get-canvas-background-for-clearing)
(if now-drawing?

17
collects/mred/private/wx/gtk/radio-box.rkt
View File

@ -8,6 +8,7 @@
"widget.rkt"
"window.rkt"
"pixbuf.rkt"
"message.rkt"
"../common/event.rkt"
"../../lock.rkt")
(unsafe!)
@ -18,7 +19,7 @@
(define _GSList (_cpointer/null 'GSList))
(define-gtk gtk_radio_button_new_with_label (_fun _GSList _string -> _GtkWidget))
(define-gtk gtk_radio_button_new_with_mnemonic (_fun _GSList _string -> _GtkWidget))
(define-gtk gtk_radio_button_new (_fun _GSList -> _GtkWidget))
(define-gtk gtk_radio_button_get_group (_fun _GtkWidget -> _GSList))
(define-gtk gtk_radio_button_set_group (_fun _GtkWidget _GSList -> _void))
@ -46,7 +47,7 @@
(define radio-gtks (for/list ([lbl (in-list labels)])
(let ([radio-gtk (cond
[(string? lbl)
(gtk_radio_button_new_with_label #f lbl)]
(gtk_radio_button_new_with_mnemonic #f (mnemonic-string lbl))]
[(send lbl ok?)
(let ([radio-gtk (gtk_radio_button_new #f)]
[image-gtk (gtk_image_new_from_pixbuf
@ -55,13 +56,15 @@
(gtk_widget_show image-gtk)
radio-gtk)]
[else
(gtk_radio_button_new_with_label #f "<bad bitmap>")])])
(gtk_radio_button_new_with_mnemonic #f "<bad bitmap>")])])
(gtk_box_pack_start gtk radio-gtk #t #t 0)
(gtk_widget_show radio-gtk)
radio-gtk)))
(for ([radio-gtk (in-list (cdr radio-gtks))])
(let ([g (gtk_radio_button_get_group (car radio-gtks))])
(gtk_radio_button_set_group radio-gtk g)))
(define dummy-gtk #f)
(super-new [parent parent]
[gtk gtk]
@ -101,9 +104,11 @@
(lambda ()
(set! no-clicked? #t)
(if (= i -1)
(let ([i (get-selection)])
(unless (= i -1)
(gtk_toggle_button_set_active (list-ref radio-gtks i) #f)))
(when (pair? radio-gtks)
(unless dummy-gtk
(set! dummy-gtk (gtk_radio_button_new
(gtk_radio_button_get_group (car radio-gtks)))))
(gtk_toggle_button_set_active dummy-gtk #t))
(gtk_toggle_button_set_active (list-ref radio-gtks i) #t))
(set! no-clicked? #f))))