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

..

Browse Source 
original commit: e1ee11d7f56c9be92ad951e90cb8b8eafe4af70e
This commit is contained in:
Robby Findler 2003-12-04 18:41:10 +00:00
parent 175762dce5
commit a692f36964
3 changed files with 2 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
collects/framework/framework.ss
View File

@ -1312,19 +1312,6 @@
"@flink editor:get-standard-style-list"
"based on the font preference symbols.")
(editor:get-fixed-faces
(-> (listof string?))
()
"Returns a list of the fixed width fonts available on this system,"
"except on unix, where it returns a list of all of the fonts."
""
"It finds the fixed width fonts by making a dummy canvas object,"
"and computes the width of both `i' and `w'. If they are the same,"
"the font is fixed width and if not, the font is not fixed width."
""
"This is very expensive under X Windows, which is why the function"
"just returns all fonts.")
(editor:get-standard-style-list
(-> (is-a?/c style-list%))
()

30
collects/framework/private/editor.ss
View File

@ -368,37 +368,9 @@
(preferences:add-callback 'framework:standard-style-list:font-name (lambda (p v) (set-font-name v)))
(preferences:add-callback 'framework:standard-style-list:font-smoothing (lambda (p v) (set-font-smoothing v)))
(unless (member (preferences:get 'framework:standard-style-list:font-name) (get-fixed-faces))
(unless (member (preferences:get 'framework:standard-style-list:font-name) (get-face-list 'mono))
(preferences:set 'framework:standard-style-list:font-name (get-family-builtin-face 'modern))))
(define get-fixed-faces
(cond
[(eq? (system-type) 'unix)
(lambda () (get-face-list))]
[else
(let ([compute-fixed-faces
(lambda ()
(let* ([canvas (make-object canvas% (make-object frame% "bogus"))]
[dc (send canvas get-dc)])
(let loop ([faces (get-face-list)])
(cond
[(null? faces) null]
[else (let* ([face (car faces)]
[font (make-object font% 12 face 'default 'normal 'normal #f)])
(let*-values ([(wi _1 _2 _3) (send dc get-text-extent "i" font)]
[(ww _1 _2 _3) (send dc get-text-extent "w" font)])
(if (and (= ww wi)
(not (zero? ww)))
(cons face (loop (cdr faces)))
(loop (cdr faces)))))]))))]
[ans #f])
(lambda ()
(unless ans
(set! ans (compute-fixed-faces))
(set! ans (cons (get-family-builtin-face 'modern)
(remove (get-family-builtin-face 'modern) ans))))
ans))]))
(define -keymap<%> (interface (basic<%>) get-keymaps))
(define keymap-mixin
(mixin (basic<%>) (-keymap<%>)

3
collects/framework/private/sig.ss
View File

@ -270,8 +270,7 @@
backup-autosave-mixin))
(define-signature framework:editor-fun^
(get-standard-style-list
set-standard-style-list-pref-callbacks
get-fixed-faces))
set-standard-style-list-pref-callbacks))
(define-signature framework:editor^
((open framework:editor-class^)
(open framework:editor-fun^)))