From 1131abd11f6fd8b46c0f8f74c9cf2e7629961eeb Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Sun, 10 Jun 2007 09:47:19 +0000 Subject: [PATCH] fix get-face-list 'mono under Mac OS X and X, and delay showing children of a frame during a container sequence svn: r6563 --- collects/mred/private/wxcanvas.ss | 12 +++++-- collects/mred/private/wxitem.ss | 19 +++++----- collects/mred/private/wxpanel.ss | 5 ++- collects/mred/private/wxtop.ss | 25 ++++++++++++- collects/mred/private/wxwindow.ss | 18 ++++++++-- src/mred/Makefile.in | 2 +- src/mred/gc2/Makefile.in | 9 +++-- src/mred/wxs/wxscheme.cxx | 40 ++++++++++++++++----- src/wxmac/src/Makefile.in | 9 +++++ src/wxmac/src/mac/wx_font.m | 28 +++++++++++++++ src/wxxt/src/GDI-Classes/Font.cc | 58 ++++++++++++++++++++----------- 11 files changed, 176 insertions(+), 49 deletions(-) create mode 100644 src/wxmac/src/mac/wx_font.m diff --git a/collects/mred/private/wxcanvas.ss b/collects/mred/private/wxcanvas.ss index d4dcb4c242..16e549bc24 100644 --- a/collects/mred/private/wxcanvas.ss +++ b/collects/mred/private/wxcanvas.ss @@ -62,6 +62,7 @@ (define wx-canvas% (make-canvas-glue% (class100 (make-control% wx:canvas% 0 0 #t #t) (parent x y w h style gl-config) + (inherit get-top-level) (private-field [tabable? #f]) (public @@ -74,13 +75,16 @@ (lambda (code alpha? meta?) (or meta? (not tabable?)))]) (sequence - (super-init style parent x y w h style "canvas" gl-config))))) + (super-init style parent x y w h (cons 'deleted style) "canvas" gl-config) + (unless (memq 'deleted style) + (send (get-top-level) show-control this #t)))))) (define (make-editor-canvas% %) (class100 % (parent x y w h name style spp init-buffer) (inherit get-editor force-redraw call-as-primary-owner min-height get-size - get-hard-minimum-size set-min-height) + get-hard-minimum-size set-min-height + get-top-level) (private-field [fixed-height? #f] [fixed-height-lines 0] @@ -195,7 +199,9 @@ (when fixed-height? (update-size)))]) (sequence - (super-init style parent x y w h (or name "") style spp init-buffer) + (super-init style parent x y w h (or name "") (cons 'deleted style) spp init-buffer) + (unless (memq 'deleted style) + (send (get-top-level) show-control this #t)) (when init-buffer (let ([mred (wx->mred this)]) (when mred diff --git a/collects/mred/private/wxitem.ss b/collects/mred/private/wxitem.ss index d5247dcc8b..afa41d91cf 100644 --- a/collects/mred/private/wxitem.ss +++ b/collects/mred/private/wxitem.ss @@ -40,7 +40,7 @@ (lambda (item% x-margin-w y-margin-h stretch-x stretch-y) (class100 (wx-make-window% item% #f) (window-style . args) (inherit get-width get-height get-x get-y - get-parent get-client-size) + get-parent get-client-size get-top-level) (private-field [enabled? #t]) (override [enable @@ -197,6 +197,7 @@ (set-min-height (init-min (get-height))) (unless (memq 'deleted window-style) + (send (get-top-level) show-control this #t) ;; For a pane[l], the creator must call the equivalent of the following, ;; delaying to let the panel's wx field get initialized before ;; panel-sizing methods are called @@ -233,7 +234,7 @@ (as-exit (lambda () (command (make-object wx:control-event% 'button)))))]) - (sequence (super-init style parent cb label x y w h style font) + (sequence (super-init style parent cb label x y w h (cons 'deleted style) font) (when border? (send (get-top-level) add-border-button this)))))) (define wx-check-box% (class100 (make-window-glue% (make-simple-control% wx:check-box%)) (mred proxy parent cb label x y w h style font) @@ -244,17 +245,17 @@ (lambda () (set-value (not (get-value))) (command (make-object wx:control-event% 'check-box)))))]) - (sequence (super-init mred proxy style parent cb label x y w h style font)))) + (sequence (super-init mred proxy style parent cb label x y w h (cons 'deleted style) font)))) (define wx-choice% (class100 (make-window-glue% (make-simple-control% wx:choice%)) (mred proxy parent cb label x y w h choices style font) (override [handles-key-code (lambda (x alpha? meta?) (or (memq x '(up down)) (and alpha? (not meta?))))]) - (sequence (super-init mred proxy style parent cb label x y w h choices style font)))) + (sequence (super-init mred proxy style parent cb label x y w h choices (cons 'deleted style) font)))) (define wx-message% (class100 (make-window-glue% (make-simple-control% wx:message%)) (mred proxy parent label x y style font) (override [gets-focus? (lambda () #f)]) - (sequence (super-init mred proxy style parent label x y style font)))) + (sequence (super-init mred proxy style parent label x y (cons 'deleted style) font)))) (define wx-gauge% (make-window-glue% @@ -270,7 +271,7 @@ ;; # pixels per unit of value. [pixels-per-value 1]) (sequence - (super-init style parent label range -1 -1 -1 -1 style font) + (super-init style parent label range -1 -1 -1 -1 (cons 'deleted style) font) (let-values ([(client-width client-height) (get-two-int-values (lambda (a b) (get-client-size a b)))]) @@ -337,7 +338,7 @@ [(wheel-up) (scroll -1) #t] [(wheel-down) (scroll 1) #t] [else #f])))]) - (sequence (super-init style parent cb label kind x y w h choices style font label-font))))) + (sequence (super-init style parent cb label kind x y w h choices (cons 'deleted style) font label-font))))) (define wx-radio-box% (make-window-glue% @@ -365,7 +366,7 @@ (set-selection i) (command (make-object wx:control-event% 'radio-box)))))]) - (sequence (super-init style parent cb label x y w h choices major style font)) + (sequence (super-init style parent cb label x y w h choices major (cons 'deleted style) font)) (private-field [enable-vector (make-vector (number) #t)])))) @@ -385,7 +386,7 @@ ;; which looks bad. (sequence - (super-init style parent func label value min-val max-val -1 -1 -1 style font) + (super-init style parent func label value min-val max-val -1 -1 -1 (cons 'deleted style) font) (let-values ([(client-w client-h) (get-two-int-values (lambda (a b) (get-client-size a b)))]) diff --git a/collects/mred/private/wxpanel.ss b/collects/mred/private/wxpanel.ss index bcc04f9820..5b4349ca6f 100644 --- a/collects/mred/private/wxpanel.ss +++ b/collects/mred/private/wxpanel.ss @@ -34,6 +34,7 @@ [on-size (lambda () (void))] [enable (lambda () (void))] [show (lambda (on?) (void))] + [is-shown? (lambda () #f)] [is-shown-to-root? (lambda () (send parent is-shown-to-root?))] [is-enabled-to-root? (lambda () (send parent is-enabled-to-root?))] [get-parent (lambda () parent)] @@ -454,7 +455,9 @@ child-infos placements))]) (sequence - (super-init style parent -1 -1 0 0 style)))) + (super-init style parent -1 -1 0 0 (cons 'deleted style)) + (unless (memq 'deleted style) + (send (get-top-level) show-control this #t))))) (define (wx-make-pane% wx:panel% stretch?) (class100 (make-container-glue% (make-glue% (wx-make-basic-panel% wx:panel% stretch?))) args diff --git a/collects/mred/private/wxtop.ss b/collects/mred/private/wxtop.ss index 9929e1cf7d..14926763e5 100644 --- a/collects/mred/private/wxtop.ss +++ b/collects/mred/private/wxtop.ss @@ -95,7 +95,8 @@ [parent-for-center parent] - [show-ht (make-hash-table)]) + [show-ht (make-hash-table)] + [fake-show-ht (make-hash-table)]) (override [enable @@ -196,6 +197,13 @@ (when perform-updates? (when pending-redraws? (force-redraw)) + (when (positive? (hash-table-count fake-show-ht)) + (let ([t fake-show-ht]) + (set! fake-show-ht (make-hash-table)) + (hash-table-for-each + t + (lambda (win v?) + (send win really-show #t))))) (when (positive? (hash-table-count show-ht)) (let ([t show-ht]) (set! show-ht (make-hash-table)) @@ -220,6 +228,21 @@ (send child show show?) (hash-table-put! show-ht child show?)))] + [show-control + (lambda (child on?) + (if (or perform-updates? + (not on?) + (child . is-a? . wx-frame%) + (child . is-a? . wx-dialog%)) + (send child really-show on?) + (begin + (if on? + (hash-table-put! fake-show-ht child #t) + (begin + (hash-table-remove! show-ht child) + (hash-table-remove! fake-show-ht child))) + (send child fake-show on?))))] + ;; force-redraw: receives a message from to redraw the ;; entire frame. ;; input: none diff --git a/collects/mred/private/wxwindow.ss b/collects/mred/private/wxwindow.ss index 1d838645a9..88e5ed75ab 100644 --- a/collects/mred/private/wxwindow.ss +++ b/collects/mred/private/wxwindow.ss @@ -52,7 +52,8 @@ (rename [super-enable enable]) (private-field - [can-accept-drag? #f]) + [can-accept-drag? #f] + [fake-shown? #f]) (public [accept-drag? (lambda () can-accept-drag?)] @@ -77,11 +78,24 @@ (set! top-level window)] [else (loop (send window get-parent))]))) top-level)]) + (public + [really-show + (lambda (on?) + (set! fake-shown? #f) + (super show on?))] + [fake-show + (lambda (on?) + (set! fake-shown? on?))]) (override [show (lambda (on?) (queue-visible) - (super show on?))] + (send (get-top-level) show-control this on?))] + [is-shown? + (lambda () + (or fake-shown? + (super is-shown?)))] + [enable (lambda (on?) (queue-active) diff --git a/src/mred/Makefile.in b/src/mred/Makefile.in index fcf1958ab4..234a80deec 100644 --- a/src/mred/Makefile.in +++ b/src/mred/Makefile.in @@ -59,7 +59,7 @@ ZLIB_INC = -I$(srcdir)/../wxcommon/zlib PNG_A = ../wxcommon/libpng/libpng.@LIBSFX@ EXTRALDFLAGS_wx_xt = -EXTRALDFLAGS_wx_mac = -framework Carbon -framework QuickTime -framework AGL -framework OpenGL -lz +EXTRALDFLAGS_wx_mac = -framework Carbon -framework Cocoa -framework QuickTime -framework AGL -framework OpenGL -lz MREDLDFLAGS = $(LDFLAGS) $(EXTRALDFLAGS_@WXVARIANT@) WXLIBS_wx_xt = ../wxxt/src/libwx_xt.@LIBSFX@ ../wxxt/contrib/xpm/lib/libXpm.@LIBSFX@ ../wxxt/utils/image/src/libimage_xt.@LIBSFX@ MREDX_wx_xt = mredx.@LTO@ diff --git a/src/mred/gc2/Makefile.in b/src/mred/gc2/Makefile.in index 7996618dd4..7b51b0c60d 100644 --- a/src/mred/gc2/Makefile.in +++ b/src/mred/gc2/Makefile.in @@ -1337,8 +1337,11 @@ wx_mac_PLAIN_OBJS = \ xform: $(XSRCS) xsrc/xcglue.c +wx_font.o : $(srcdir)/../../wxmac/src/mac/wx_font.m + $(CXX) -o wx_font.o -c $(srcdir)/../../wxmac/src/mac/wx_font.m + wx_xt_LIBS = ../../wxxt/contrib/xpm/lib/libXpm.@LTA@ @JPEG_A@ @PNG_A@ @ZLIB_A@ -wx_mac_LIBS = -framework Carbon -framework QuickTime -framework AGL -framework OpenGL @JPEG_A@ @PNG_A@ -lz @LIBS@ +wx_mac_LIBS = -framework Carbon -framework Cocoa -framework QuickTime -framework AGL -framework OpenGL @JPEG_A@ @PNG_A@ -lz @LIBS@ MREDLINKER = @MREDLINKER@ @@ -1375,8 +1378,8 @@ MRFWRES = PLT_MrEd.framework/Versions/$(FWVERSION)_3m/Resources/PLT_MrEd.rsrc cp -r "PLT_MrEd.framework/Versions/$(FWVERSION)_3m/Resources" "../PLT_MrEd.framework/Versions/$(FWVERSION)_3m/Resources" /usr/bin/install_name_tool -change "PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "@executable_path/../../../PLT_MrEd.framework/Versions/$(FWVERSION)_3m/PLT_MrEd" "../MrEd@MMM@.app/Contents/MacOS/MrEd@MMM@" -$(MRFW) : $(XOBJS) $(@WXVARIANT@_PLAIN_OBJS) ../../mzscheme/libmzscheme3m.@LIBSFX@ - $(MREDLINKER) -dynamiclib -o $(MRFW) -Wl,-headerpad_max_install_names $(XOBJS) $(@WXVARIANT@_PLAIN_OBJS) ../../mzscheme/libmzscheme3m.@LIBSFX@ $(@WXVARIANT@_LIBS) @X_EXTRA_LIBS@ +$(MRFW) : $(XOBJS) $(@WXVARIANT@_PLAIN_OBJS) ../../mzscheme/libmzscheme3m.@LIBSFX@ wx_font.o + $(MREDLINKER) -dynamiclib -o $(MRFW) -Wl,-headerpad_max_install_names $(XOBJS) $(@WXVARIANT@_PLAIN_OBJS) ../../mzscheme/libmzscheme3m.@LIBSFX@ $(@WXVARIANT@_LIBS) @X_EXTRA_LIBS@ wx_font.o $(MRFWRES): $(srcdir)/../../mac/osx_appl.ss $(srcdir)/../../mac/cw/MrEd.r rm -rf PLT_MrEd.framework/Resources PLT_MrEd.framework/PLT_MrEd diff --git a/src/mred/wxs/wxscheme.cxx b/src/mred/wxs/wxscheme.cxx index 7e2a3faf4b..6d13fabd50 100644 --- a/src/mred/wxs/wxscheme.cxx +++ b/src/mred/wxs/wxscheme.cxx @@ -61,7 +61,7 @@ extern void wx_release_lazy_regions(); #ifdef WX_USE_XFT #include -extern char **wxGetCompleteFaceList(int *_len); +extern char **wxGetCompleteFaceList(int *_len, int mono_only); #endif #ifdef wx_mac @@ -1021,6 +1021,20 @@ static int indirect_strcmp(const void *a, const void *b) { return strcmp(*(char **)a, *(char **)b); } + +static int is_x_monospace(char *s) +{ + if (s[0] == '-') { + /* Full X font name. Check for "-m-" in name. */ + int j; + for (j = 0; s[j+2]; j++) { + if ((s[j] == '-') && (s[j+1] == 'm') && (s[j+2] == '-')) + return 1; + } + } + + return 0; +} #endif @@ -1141,12 +1155,16 @@ char *wx_get_mac_font_name(FMFontFamily fam, unsigned char *fname, int *_l) typedef int (*Indirect_Cmp_Proc)(const void *, const void *); +#ifdef wx_mac +extern "C" int wx_isFamilyFixedWidth(FMFontFamily fam); +#endif + static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv) { Scheme_Object *first = scheme_null, *last = NULL; int mono_only = 0; #ifdef wx_x - int count, i = 0; + int count, i = 0, pos; char **xnames, **names; int last_pos = -1, last_len = 0; #endif @@ -1180,11 +1198,13 @@ static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv) xnames = XListFonts(wxAPP_DISPLAY, "*", 50000, &count); names = (char **)scheme_malloc_atomic(sizeof(char*)*count); + pos = 0; for (i = 0; i < count; i++) { - names[i] = xnames[i]; + if (!mono_only || is_x_monospace(xnames[i])) + names[pos++] = xnames[i]; } - qsort(names, count, sizeof(char *), + qsort(names, pos, sizeof(char *), (Indirect_Cmp_Proc)indirect_strcmp); i = 0; @@ -1211,12 +1231,12 @@ static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv) Scheme_Object *pr; #ifdef wx_x - while ((i < count) + while ((i < pos) && ((last_pos >= 0) && !strncmp(names[i], names[last_pos], last_len))) { i++; } - if (i >= count) + if (i >= pos) break; last_pos = i; @@ -1249,6 +1269,8 @@ static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv) #ifdef wx_mac if (FMGetNextFontFamily(&iterator, &fam) != noErr) break; + if (mono_only && !wx_isFamilyFixedWidth(fam)) + continue; s = wx_get_mac_font_name(fam, fname, &l); #endif #ifdef wx_msw @@ -1271,8 +1293,8 @@ static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv) } #ifdef wx_x - XFreeFontNames(xnames); - xnames = NULL; + XFreeFontNames(xnames); + xnames = NULL; #endif #ifdef wx_msw ReleaseDC(NULL, dc); @@ -1289,7 +1311,7 @@ static Scheme_Object *wxSchemeGetFontList(int argc, Scheme_Object **argv) char **fl; int len, i; - fl = wxGetCompleteFaceList(&len); + fl = wxGetCompleteFaceList(&len, mono_only); for (i = 0; i < len; i++) { first = scheme_make_pair(scheme_make_utf8_string(fl[i]), first); diff --git a/src/wxmac/src/Makefile.in b/src/wxmac/src/Makefile.in index 5bc1e7b7e4..2c82b59350 100644 --- a/src/wxmac/src/Makefile.in +++ b/src/wxmac/src/Makefile.in @@ -146,6 +146,8 @@ OBJS = \ wx_24to8.o \ wx_image.o \ wx_xbm.o \ +\ + wx_font.o \ \ $(MIN_OBJS) @@ -388,6 +390,13 @@ ALHeirarchical.o : $(ALISTDEPS) $(ALISTDIR)/ALHeirarchical.c ALSelectors.o : $(ALISTDEPS) $(ALISTDIR)/ALSelectors.c $(CC) $(ALISTCCFLAGS) -o ALSelectors.o -c $(ALISTDIR)/ALSelectors.c +######################################## +# Cocoa fonts # +######################################## + +wx_font.o : $(srcdir)/mac/wx_font.m + $(CXX) -o wx_font.o -c $(srcdir)/mac/wx_font.m + ######################################## # Make Depends # ######################################## diff --git a/src/wxmac/src/mac/wx_font.m b/src/wxmac/src/mac/wx_font.m new file mode 100644 index 0000000000..e3b19fc4d5 --- /dev/null +++ b/src/wxmac/src/mac/wx_font.m @@ -0,0 +1,28 @@ + +/* The easiest way to find out whether a font is fixed-width is to + jump over the to Coacao world. The ATS and Cocoa worlds are + connected through the PostScript name of a font. */ + +#import + +int wx_isFamilyFixedWidth(FMFontFamily fam) +{ + FMFont fnt; + StyleParameter intrinsic; + + if (!FMGetFontFromFontFamilyInstance(fam, 0, &fnt, &intrinsic)) { + ATSFontRef ats; + ats = FMGetATSFontRefFromFont(fnt); + if (ats) { + CFStringRef ref; + NSFont *nsfnt; + if (!ATSFontGetPostScriptName(ats, kATSOptionFlagsDefault, &ref)) { + nsfnt = [NSFont fontWithName: (NSString *)ref size: 12]; + CFRelease(ref); + return [nsfnt isFixedPitch]; + } + } + } + + return 0; +} diff --git a/src/wxxt/src/GDI-Classes/Font.cc b/src/wxxt/src/GDI-Classes/Font.cc index bae4e874a0..4a823a5ae3 100644 --- a/src/wxxt/src/GDI-Classes/Font.cc +++ b/src/wxxt/src/GDI-Classes/Font.cc @@ -76,30 +76,38 @@ static int complete_face_list_size; static char **complete_face_list; static wxFontStruct **complete_font_list; -char **wxGetCompleteFaceList(int *_len) +char **wxGetCompleteFaceList(int *_len, int mono_only) { char buf[256], *s, *copy; int ssize, i, j, pos, len, scalable; XftFontSet *fs; + int face_list_size; + char **face_list; + wxFontStruct **font_list; - if (complete_face_list) { + if (complete_face_list && !mono_only) { if (_len) *_len = complete_face_list_size; return complete_face_list; } - fs = XftListFonts(wxAPP_DISPLAY, DefaultScreen(wxAPP_DISPLAY), NULL, - /* I'm assuming that every family is either - scalable or not. We inspect scalability - to bias substitution to scalable fonts */ - XFT_FAMILY, XFT_SCALABLE, - NULL); + if (mono_only) { + fs = XftListFonts(wxAPP_DISPLAY, DefaultScreen(wxAPP_DISPLAY), + XFT_SPACING, XftTypeInteger, XFT_MONO, NULL, + /* I'm assuming that every family is either + scalable or not. We inspect scalability + to bias substitution to scalable fonts */ + XFT_FAMILY, XFT_SCALABLE, + NULL); + } else { + fs = XftListFonts(wxAPP_DISPLAY, DefaultScreen(wxAPP_DISPLAY), NULL, + XFT_FAMILY, XFT_SCALABLE, + NULL); + } - complete_face_list_size = fs->nfont; - wxREGGLOB(complete_face_list); - wxREGGLOB(complete_font_list); - complete_face_list = new WXGC_PTRS char*[complete_face_list_size]; - complete_font_list = (wxFontStruct **)(new WXGC_ATOMIC char[sizeof(wxFontStruct*) * complete_face_list_size]); + face_list_size = fs->nfont; + face_list = new WXGC_PTRS char*[face_list_size]; + font_list = (wxFontStruct **)(new WXGC_ATOMIC char[sizeof(wxFontStruct*) * face_list_size]); pos = 0; for (i = 0; i < fs->nfont; i++) { @@ -130,19 +138,29 @@ char **wxGetCompleteFaceList(int *_len) copy[len + 1] = 0; if (scalable) { - complete_face_list[pos] = copy; - complete_font_list[pos] = NULL; + face_list[pos] = copy; + font_list[pos] = NULL; pos++; } else { /* unscalable at end, to discourage use in substitutions */ j = fs->nfont - (i - pos) - 1; - complete_face_list[j] = copy; - complete_font_list[j] = NULL; + face_list[j] = copy; + font_list[j] = NULL; } } XftFontSetDestroy(fs); - return wxGetCompleteFaceList(_len); + if (!mono_only) { + wxREGGLOB(complete_face_list); + wxREGGLOB(complete_font_list); + complete_face_list_size = face_list_size; + complete_face_list = face_list; + complete_font_list = font_list; + } + + if (_len) + *_len = face_list_size; + return face_list; } static wxFontStruct *prev_subs; @@ -153,7 +171,7 @@ static wxFontStruct *doFindAAFont(Display *dpy, wxFontStruct *xfont, int c, int wxFontStruct *naya; int i; - wxGetCompleteFaceList(NULL); + wxGetCompleteFaceList(NULL, 0); for (i = 0; i < complete_face_list_size; i++) { if (!complete_font_list[i]) { @@ -590,7 +608,7 @@ void *wxFont::GetNextAASubstitution(int index, int cval, double scale_x, double } if (!name[i]) { if (index == c + 1) { - wxGetCompleteFaceList(NULL); + wxGetCompleteFaceList(NULL, 0); c = -1; doFindAAFont(wxAPP_DISPLAY, NULL, cval, &c); if (c >= 0) {