--- a/XWorkstation.st Tue Jun 27 04:21:46 1995 +0200
+++ b/XWorkstation.st Sun Jul 02 18:18:17 1995 +0200
@@ -35,7 +35,7 @@
COPYRIGHT (c) 1989 by Claus Gittinger
All Rights Reserved
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.48 1995-06-27 02:20:55 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.49 1995-07-02 16:18:06 claus Exp $
'!
!XWorkstation class methodsFor:'documentation'!
@@ -56,7 +56,7 @@
version
"
-$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.48 1995-06-27 02:20:55 claus Exp $
+$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.49 1995-07-02 16:18:06 claus Exp $
"
!
@@ -2511,8 +2511,6 @@
"set the text selection, and make aWindowId be the owner.
This can be used by any other X application."
- |cutBuffer|
-
(self setSelectionOwner:aWindowId of:primaryAtom) ifFalse:[
'ownerchange failed' errorPrintNL.
].
@@ -2661,40 +2659,119 @@
next time. The elements of the returned collection are instances of
FontDescription."
- |stream aName fntDescr|
+ |stream names aName fntDescr|
listOfXFonts isNil ifTrue:[
- stream := PipeStream readingFrom:'xlsfonts ''*'''.
- stream isNil ifTrue:[^ nil].
- listOfXFonts := OrderedCollection new.
- [stream atEnd] whileFalse:[
- aName := stream nextLine.
- aName notNil ifTrue:[
- self decomposeXFontName:aName into:
- [:family :face :style :size :coding |
- family notNil ifTrue:[
- fntDescr := FontDescription
- family:family
- face:face
- style:style
- size:size
- encoding:coding.
- listOfXFonts add:fntDescr
- ]
- ]
- ]
+"/
+"/ old code; using a pipe to xlsfonts
+"/
+"/ stream := PipeStream readingFrom:'xlsfonts ''*'''.
+"/ stream isNil ifTrue:[^ nil].
+"/ listOfXFonts := OrderedCollection new.
+"/ [stream atEnd] whileFalse:[
+"/ aName := stream nextLine.
+"/ aName notNil ifTrue:[
+"/ self decomposeXFontName:aName into:
+"/ [:family :face :style :size :coding |
+"/ family notNil ifTrue:[
+"/ fntDescr := FontDescription
+"/ family:family
+"/ face:face
+"/ style:style
+"/ size:size
+"/ encoding:coding.
+"/ listOfXFonts add:fntDescr
+"/ ]
+"/ ]
+"/ ]
+"/ ].
+"/ stream close.
+"/ "if xlsfont is broken ... (hey sco)"
+"/ (listOfXFonts size == 0) ifTrue:[
+"/ listOfXFonts := nil
+"/ ] ifFalse:[
+"/ listOfXFonts sort:[:a :b | a family < b family].
+"/ ].
+
+ "/
+ "/ new code:
+ "/ use new primitive to get font names;
+ "/ this is much faster, and also works on systems where
+ "/ a) xlsfonts is broken (sco)
+ "/ b) xlsfonts is not available (aix)
+ "/
+ names := self getAvailableFontsMatching:'*'.
+ names isNil ifTrue:[
+ "no names returned ..."
+ ^ nil
].
- stream close.
- "if xlsfont is broken ... (hey sco)"
- (listOfXFonts size == 0) ifTrue:[
- listOfXFonts := nil
- ] ifFalse:[
- listOfXFonts sort:[:a :b | a family < b family].
- ]
+ listOfXFonts := names collect:[:aName |
+ |fntDescr|
+
+ self decomposeXFontName:aName into:
+ [:family :face :style :size :coding |
+ family notNil ifTrue:[
+ fntDescr := FontDescription
+ family:family
+ face:face
+ style:style
+ size:size
+ encoding:coding.
+ ] ifFalse:[
+ fntDescr := FontDescription
+ name:aName
+ ]
+ ].
+ fntDescr
+ ].
+
].
^ listOfXFonts
- "Display listOfAvailableFonts"
+ "
+ Display listOfAvailableFonts
+ "
+!
+
+getAvailableFontsMatching:pattern
+ "return anArray filled with font names patching aPattern"
+
+%{ /* UNLIMITEDSTACK */
+
+ int nnames = 1500;
+ int available = nnames + 1;
+ char **fonts;
+ OBJ arr, str;
+ OBJ __ARRAY_NEW_INT(), _MKSTRING_INIT();
+ int i;
+
+ if (ISCONNECTED) {
+ if (__isString(pattern)) {
+ for (;;) {
+ fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
+ if ((fonts == NULL) || (available < nnames)) break;
+ XFreeFontNames(fonts);
+ nnames = available * 2;
+ }
+ if (fonts == NULL) {
+ RETURN ( nil );
+ }
+ arr = __ARRAY_NEW_INT(available);
+ if (! arr) {
+ RETURN (nil);
+ }
+ for (i=0; i<available; i++) {
+ PROTECT(arr);
+ str = _MKSTRING_INIT(fonts[i]);
+ UNPROTECT(arr);
+ __ArrayInstPtr(arr)->a_element[i] = str;
+ __STORE(arr, str);
+ }
+ RETURN (arr);
+ }
+ }
+%}.
+ ^ nil
!
getFontWithFamily:familyString face:faceString