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

.

Browse Source 
original commit: 585e32fb45b28980a907a650b7b817c5606f23bc
This commit is contained in:
Matthew Flatt 1999-11-29 21:36:37 +00:00
parent 0e9e023c7d
commit f54d066d3c
1 changed files with 5 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
src/mred/wrap/mred.ss
View File

@ -2388,10 +2388,11 @@
(define (font->delta f) (define (font->delta f)
(define d (make-object wx:style-delta%)) (define d (make-object wx:style-delta%))
(let ([v (send f get-face)]) (let ([v (send f get-face)]
[m (send f get-family)])
(if v (if v
(send d set-delta-face v) (send d set-delta-face v m)
(send d set-delta 'change-family (send f get-family)))) (send d set-delta 'change-family m)))
(send d set-delta 'change-size (send f get-point-size)) (send d set-delta 'change-size (send f get-point-size))
(send d set-delta 'change-style (send f get-style)) (send d set-delta 'change-style (send f get-style))
(send d set-delta 'change-weight (send f get-weight)) (send d set-delta 'change-weight (send f get-weight))
@ -4920,7 +4921,7 @@
(lambda (e) (lambda (e)
(send e change-style (make-object wx:style-delta% 'change-family f))))) (send e change-style (make-object wx:style-delta% 'change-family f)))))
'("Standard" "Decorative" "Roman" "Script" "Swiss" "Fixed" "Symbol") '("Standard" "Decorative" "Roman" "Script" "Swiss" "Fixed" "Symbol")
'(default decorative roman script swiss fixed symbol)) '(default decorative roman script swiss modern symbol))
(mk-sep family) (mk-sep family)
(mk "Choose..." family (lambda (e) (let ([f (get-font-from-user)]) (mk "Choose..." family (lambda (e) (let ([f (get-font-from-user)])
(when f (when f