"

 COPYRIGHT (c) 1991 by Claus Gittinger

 COPYRIGHT (c) 2016 Jan Vrany

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

"{ Package: 'stx:libwidg' }"

"{ NameSpace: Smalltalk }"

DialogBox subclass:#FontPanel

	instanceVariableNames:'previewField listOfEncodings allFonts fontsPerFamily familyList

		faceList sizeList revertButton currentFamily currentFace

		currentStyle currentFaceAndStyle currentSize sizeUnit

		currentEncoding initialFont selectedFont nameLabel encodingFilter

		encodingFilterField encodingLabel combinedFilter encoding

		sizeLabelHolder pixelPointSwitch xftFontsOnlyHolder

		changeFontInAllViewsHolder withChangeFontInAllViewsCheckBox

		withChangeFontInAllViewsCheckBoxVisibleHolder

		decorativeOnlyHolder nonDecorativeOnlyHolder monospacedOnlyHolder

		nonMonospacedOnlyHolder'

	classVariableNames:''

	poolDictionaries:''

	category:'Views-DialogBoxes'

!

!FontPanel class methodsFor:'documentation'!

copyright

"

 COPYRIGHT (c) 1991 by Claus Gittinger

 COPYRIGHT (c) 2016 Jan Vrany

	      All Rights Reserved

 This software is furnished under a license and may be used

 only in accordance with the terms of that license and with the

 inclusion of the above copyright notice.   This software may not

 be provided or otherwise made available to, or used by, any

 other person.  No title to or ownership of the software is

 hereby transferred.

"

!

documentation

"

    this class implements the font chooser.

    Notice: 

        this is a very old dialog; 

        it was written before the UI-framework was available and the UI is completely

        programmed manually (see initialize method).

        Therefore, it desperately asks to be rewritten using the UIPainter...

    [author:]

        Claus Gittinger

    [see also:]

        Font FontDescription

        View Dialog

"

!

examples

"

    very simple:

                                                                        [exBegin]

        |font|

        font := FontPanel fontFromUser.

        Transcript showCR:font

                                                                        [exEnd]

    with initial font:

                                                                        [exBegin]

        |font|

        font := FontPanel 

                    fontFromUserInitial:(Font 

                                            family:'courier'

                                            size:12).

        Transcript showCR:font

                                                                        [exEnd]

    with initial font & title:

                                                                        [exBegin]

        |font|

        font := FontPanel 

                    fontFromUserInitial:(Font 

                                            family:'courier'

                                            size:12)

                                  title:'select a fooBar font'.

        Transcript showCR:font

                                                                        [exEnd]

    full setup; setting a filter to only present iso fonts

    and callBack action:

                                                                        [exBegin]

        |panel|

        panel := FontPanel new.

        panel label:'hi there - which iso font ?'.

        panel filter:[:fd | fd encoding notNil

                            and:[fd encoding startsWith:'iso']].

        panel action:[:family :face :style :size | 

                        Transcript showCR:'family:' , family.

                        Transcript showCR:'face:' , face.

                        Transcript showCR:'style:' , style.

                        Transcript showCR:'size:' , size printString.

                     ].

        panel open

                                                                        [exEnd]

"

! !

!FontPanel class methodsFor:'defaults'!

defaultAsciiSampleString

    ^ (self sampleStringWithAllLetters) , '

ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz

1234567890    !!@#$%^&*(){}[]:"~;,./<>?

'

!

defaultExtent

    "return the default extent of my instances.

     The value returned here is usually ignored, and

     the value from preferredExtent taken instead."

    ^ (Screen current pixelPerMillimeter * (200 @ 150)) rounded

    "Modified: 22.4.1996 / 23:36:19 / cg"

!

defaultJIS0201SampleString

    "return the sample jis preview text"

    ^ (self defaultLatin1SampleString).

!

defaultJISSampleString

    "return the sample jis preview text"

    ^ 

'The quick brown fox

jumps over the lazy dog.

' , #(16r65E5 16r672C 16r8A9E) asUnicodeString

!

defaultLatin1SampleString

    "return the sample latin1 preview text"

    ^ (self defaultAsciiSampleString) , ''

!

defaultSampleStringForEncoding:enc

    |string lines|

    enc notNil ifTrue:[    

        ((enc startsWith:'unicode') or:[enc startsWith:'iso10646-']) ifTrue:[

            ^ self defaultUnicodeSampleString.

        ].

        (enc startsWith:'ms-ansi') ifTrue:[

            ^ self defaultUnicodeSampleString.

        ].

        (enc startsWith:'jis') ifTrue:[

            (enc includesString:'0201') ifTrue:[

                string := self defaultJIS0201SampleString    

            ] ifFalse:[

                string := self defaultJISSampleString

            ]

        ] ifFalse:[

        ]

    ].

    string isNil ifTrue:[

        string := self defaultLatin1SampleString.

    ].

    lines := string asStringCollection.

    [

        lines := lines encodeFrom:#unicode into:enc

    ] on:CharacterEncoderError do:[:ex|

        "substitute a default value for codes that cannot be represented

         in the new character set"

        ex proceedWith:ex defaultValue.

    ].

    ^ lines.

!

defaultUnicodeSampleString

    "return the sample unicode preview text"

    |t|

    t := (self defaultAsciiSampleString) , '

diaresis: 

accent: 

special: ' ,  #(16r20AC) asUnicodeString , '

math: ' ,  #(16r2200 16r2203 16r221E 16r2208 16r2209) asUnicodeString , '

cyrillic: ' ,  #(16r440 16r443 16r441 16r441 16r43A 16r438 16r439 16r20 16r44F 16r437 16r44B 16r43A) asUnicodeString , '

greek: ' , #(16r395 16r3BB 16r3BB 16r3B7 16r3BD 16r3B9 16r3BA 16r3AC) asUnicodeString , '

japanese: ' , #(16r65E5 16r672C 16r8A9E) asUnicodeString , '

chinese: ' ,

#(16r4F60 16r597D 16r3002) asUnicodeString , ' ' ,

#(16r6211 16r4E0D 16r8BF4 16r4E2D 16r6587) asUnicodeString , '

korean: ' , #( 50504 45397 54616 49464 50836 ) asUnicodeString , '

' ", 'hebrew: ' , #( 16r5E9 16r5dc 16r5d5 16r5dd 16r20 16r5e2 16r5d5 16r5dc 16r5dd ) asUnicodeString , ' (sorry: right-to-left writing is not supported)

' ", ''.

    ^ t

    "Modified: / 10-08-2010 / 16:05:16 / cg"

!

sampleStringWithAllLetters

    ^ (self classResources 

        at:'CHARSET_TEST_SENTENCE' 

        ifAbsent:'The quick brown fox jumps over the lazy dog') withCRs

! !

!FontPanel class methodsFor:'help'!

flyByHelpSpec

    <resource: #help>

    ^ Dictionary new 

        addPairsFrom:#(

#fontName

'Shows the full name of the selected font.' 

#fontEncodingFilter

'Filter fonts by encodings.\Almost any can be used for Latin1 languages (English, German, French, Italian etc.).\For other European languages, it should be a Latin-X or Unicode font;\For most middle and far east languages, a Unicode font is required.\\Notice that although ISO10646 is Unicode, many fonts only contain a subset of the required characters.\Check the preview above.' 

#fontsEncoding

'Shows the selected font''s encoding.' 

#xftFontsOnlyHolder

'Filter to only show the nicer looking xft fonts and ignore the ugly X fonts (Linux/OSX only).\\Be aware that if X is used with remote windows via a slow communication line,\it may be preferrable to avoid xft fonts, as they require much more network bandwidth.'

#pixelPointSwitch

'Switch between point and pixels in the size list.\A point is defined as 1/72th of an inch, and a common unit in typesetting.\Not to confuse with pixels, which are dots on your screen.\It is usually not a good idea, to specify font sizes by pixels.' 

#flushCachedListOfFonts

'Flush the cached list of fonts, and rescan the system for available fonts.\This may take a long time in some systems,\and is only needed if you install new fonts while ST/X is running.'

#changeInAllTextViews

'If checked, your font choice is applied to all text views (in ST/X),\and will also be the default for new windows.\Otherwise, it will only affect the current textview.\\To make your choice persistent across sessions, go to the settings dialog and save the settings into your preferences file.'

)

! !

!FontPanel class methodsFor:'menu specs'!

previewMenu

    "This resource specification was automatically generated

     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,

     the MenuEditor may not be able to read the specification."

    "

     MenuEditor new openOnClass:FontPanel andSelector:#previewMenu

     (Menu new fromLiteralArrayEncoding:(FontPanel previewMenu)) startUp

    "

    <resource: #menu>

    ^ 

     #(Menu

        (

         (MenuItem

            label: 'Copy'

            itemValue: previewCopySelection

            translateLabel: true

          )

         (MenuItem

            label: '-'

          )

         (MenuItem

            label: 'Show Character Set'

            itemValue: previewShowCharacterSet

            translateLabel: true

            isVisible: characterSetViewClassAvailable

          )

         (MenuItem

            label: 'Show Character Set (Using xfd)'

            itemValue: previewShowCharacterSetUsingXFD

            translateLabel: true

            isVisible: osIsUNIXAndXfdIsAvailable

            enabled: xfdCanBeUsed

          )

         (MenuItem

            label: '-'

            isVisible: characterSetViewClassAvailableOrOSIsUNIX

          )

         (MenuItem

            label: 'Inspect Font'

            itemValue: previewInspectFont

            translateLabel: true

          )

         (MenuItem

            label: 'Copy Fontname'

            itemValue: copyFontName

            translateLabel: true

          )

         )

        nil

        nil

      )

    "Modified: / 11-10-2006 / 21:51:02 / cg"

! !

!FontPanel class methodsFor:'startup'!

fontFromUser

    "open a fontPanel and return the selected font, 

     or nil if abort is pressed"

    ^ self new fontFromUser

    "

     FontPanel fontFromUser

    "

    "Modified: 27.2.1996 / 00:51:59 / cg"

!

fontFromUserInitial:aFont

    "open a fontPanel showing aFont initially,

     and return the selected font, or nil if abort is pressed"

    ^ self new fontFromUserInitial:aFont

    "

     FontPanel fontFromUserInitial:(Font family:'courier' size:12)

     FontPanel fontFromUserInitial:MenuPanel defaultFont

    "

!

fontFromUserInitial:aFont title:someTitle

    "open a fontPanel with title and return the selected font, 

     or nil if abort is pressed"

    ^ self new 

        fontFromUserInitial:aFont title:someTitle

    "

     FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'

    "

    "Created: 27.2.1996 / 00:59:46 / cg"

    "Modified: 29.4.1996 / 09:45:34 / cg"

!

fontFromUserInitial:initialFont title:someTitle filter:aFilterBlock

    "open a fontPanel with title and font-filter

     and return the selected font, or nil if abort is pressed"

    ^ self new 

        fontFromUserInitial:initialFont title:someTitle 

        filter:aFilterBlock

    "

     FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'

    "

    "Created: 27.2.1996 / 00:59:46 / cg"

    "Modified: 10.4.1997 / 09:53:03 / cg"

!

fontFromUserInitial:initialFont title:someTitle filter:aFilterBlock encoding:encoding

    "open a fontPanel with title and font-filter

     and return the selected font, or nil if abort is pressed"

    ^ self new 

        fontFromUserInitial:initialFont title:someTitle 

        filter:aFilterBlock encoding:encoding

    "

     FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'

    "

!

fontFromUserInitial:initialFont title:someTitle filter:aFilterBlock encoding:encoding enabled:enabled

    "open a fontPanel with title and font-filter

     and return the selected font, or nil if abort is pressed"

    ^ self new

        fontFromUserInitial:initialFont title:someTitle 

        filter:aFilterBlock encoding:encoding 

        enabled:enabled

    "

     FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'

    "

    "Created: 27.2.1996 / 00:59:46 / cg"

    "Modified: 10.4.1997 / 09:53:03 / cg"

!

fontFromUserInitial:initialFont title:someTitle filter:aFilterBlock encoding:encoding enabled:enabled onChangeAll:actionToChangeAll

    "open a fontPanel with title and font-filter

     and return the selected font, or nil if abort is pressed"

    ^ self new

        fontFromUserInitial:initialFont title:someTitle 

        filter:aFilterBlock encoding:encoding 

        enabled:enabled

        onChangeAll:actionToChangeAll

    "

     FontPanel fontFromUserInitial:(Font family:'courier' size:12) title:'select some font'

    "

    "Created: 27.2.1996 / 00:59:46 / cg"

    "Modified: 10.4.1997 / 09:53:03 / cg"

!

openOn:aFont

    "open a fontPanel showing aFont initially.

     This panel is for information only - no font selection is possible."

    ^ self 

        fontFromUserInitial:aFont 

        title:(aFont userFriendlyName)

        filter:nil

        encoding:nil

        enabled:false

    "

     FontPanel openOn:(Font family:'courier' size:12)

     FontPanel openOn:MenuPanel defaultFont

     FontPanel fontFromUser

    "

! !

!FontPanel methodsFor:'accessing'!

action:aFourArgBlock

    "set the action to be evaluated on ok.

     The block will be evaluated with family, face, style, size and encoding."

    okAction := aFourArgBlock

    "Modified: 10.4.1997 / 09:49:58 / cg"

!

changeFontInAllViews

    "valid after closing"

    ^ self changeFontInAllViewsHolder value    

!

changeFontInAllViewsHolder

    changeFontInAllViewsHolder isNil ifTrue:[

        changeFontInAllViewsHolder := false asValue

    ].

    ^ changeFontInAllViewsHolder

!

decorativeOnlyHolder

    decorativeOnlyHolder isNil ifTrue:[

        decorativeOnlyHolder := false asValue

    ].

    ^ decorativeOnlyHolder

!

encoding:aPattern

    "set the encoding goal"

    ((aPattern = #'iso8859-1')

    or:[ (aPattern = #'iso10646-1') ]) ifFalse:[