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)])) 1)]))
(define bg-col (make-object color% "white")) (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 (set-canvas-background col) (set! bg-col col))
(define/public (get-canvas-background-for-clearing) (define/public (get-canvas-background-for-clearing)
(if now-drawing? (if now-drawing?

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

@ -21,6 +21,7 @@
(import-class NSMatrix NSButtonCell) (import-class NSMatrix NSButtonCell)
(define NSRadioModeMatrix 0) (define NSRadioModeMatrix 0)
(define NSListModeMatrix 2)
(define-objc-class MyMatrix NSMatrix (define-objc-class MyMatrix NSMatrix
#:mixins (FocusResponder) #:mixins (FocusResponder)
@ -115,8 +116,14 @@
(set-focus))) (set-focus)))
(define/public (set-selection i) (define/public (set-selection i)
(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) (tellv (get-cocoa) selectCellAtRow: #:type _NSInteger (if horiz? 0 i)
column: #:type _NSInteger (if horiz? i 0))) column: #:type _NSInteger (if horiz? i 0))))
(define/public (get-selection) (define/public (get-selection)
(if horiz? (if horiz?
(tell #:type _NSInteger (get-cocoa) selectedColumn) (tell #:type _NSInteger (get-cocoa) selectedColumn)

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

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

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

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