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

.

Browse Source 
original commit: eb362f1ccadad9cafaad6fdd46a0309f883e0bb1
This commit is contained in:
Matthew Flatt 2003-05-08 15:32:40 +00:00
parent 021a6747ab
commit 28b3aa1c8e
2 changed files with 20 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
collects/mred/edit.ss
View File

@ -56,6 +56,20 @@
(append-editor-operation-menu-items edit-menu #f) (append-editor-operation-menu-items edit-menu #f)
(append-editor-font-menu-items font-menu) (append-editor-font-menu-items font-menu)
(let ([m (make-object menu% "Smoothing" font-menu)])
(let ([mk (lambda (name v)
(make-object menu-item% name m
(lambda (i e)
(let* ([o (send f get-edit-target-object)])
(and o
(o . is-a? . editor<%>)
(send o change-style
(make-object style-delta% 'change-smoothing v)))))))])
(mk "Default" 'family+size-default)
(mk "System Default" 'system-default)
(mk "Smoothed" 'smoothed)
(mk "Not Smoothed" 'unsmoothed)))
((current-text-keymap-initializer) (send e get-keymap)) ((current-text-keymap-initializer) (send e get-keymap))
(send c set-editor e) (send c set-editor e)

6
collects/mred/private/kernel.ss
View File

@ -505,6 +505,7 @@
(define-class font% object% #f (define-class font% object% #f
get-font-id get-font-id
get-underlined get-underlined
get-smoothing
get-weight get-weight
get-point-size get-point-size
get-style get-style
@ -1327,6 +1328,10 @@
set-weight-on set-weight-on
get-weight-off get-weight-off
set-weight-off set-weight-off
get-smoothing-on
set-smoothing-on
get-smoothing-off
set-smoothing-off
get-style-on get-style-on
set-style-on set-style-on
get-style-off get-style-off
@ -1366,6 +1371,7 @@
get-foreground get-foreground
get-font get-font
get-underlined get-underlined
get-smoothing
get-style get-style
get-weight get-weight
get-size get-size