"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      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:libview' }"

Dictionary subclass:#ResourcePack
	instanceVariableNames:'superPack packsClassName fileReadFailed'
	classVariableNames:'Packs'
	poolDictionaries:''
	category:'Interface-Internationalization'
!

!ResourcePack class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 1993 by Claus Gittinger
	      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 supports easy customization of smalltalk code (i.e. internationalization
    and viewStyle adaption).
    ResourcePacks are class specific, meaning that every subclass of View
    and ApplicationModel has an instance of ResourcePack (instVar called 'resources') 
    which is created when the first instance of the view/app is created,
    and cached in a class-instVar (so the file is only read once).

    The resourcePack consists of a mapping from strings to values, which are
    then used in labels, buttons, menus etc.
    The resourcePack initializes itself from a file found in 'resources/<className>.rs',
    where 'className' is built by the usual abbreviation mechanism (see abbrev-files).

    Conditional mappings are possible, by including lines as:
	#if <expression>
	#endif
    in the resourcefile. Example:
    file 'foo.rs':
	#if Language == #de
	'abort' 'Abbruch'
	#endif
	#if Language == #fr
	'abort' 'canceller'
	#endif

    the corresponding resource-strings are accessed (from methods within the class)
    using:
	resources string:'abort'

    returning the mapped string (i.e. 'Abbruch' if the global Language is set
    to #de)..

    If no corresponding entry is found in the resources, the key is returned;
    alternatively, use:
	resources string:'foo' default:'bar'
    which returns 'bar', if no resource definition for 'foo' is found.

    Translations can also include arguments, such as:
	resources string:'really delete %1' with:fileName

    This scheme has the advantage, that you can write your programs using your
    native language strings. Later, when new languages are to be supported,
    simply create a resource file for the class and add translations for
    all those strings. (find the keys by looking at users of resource or senders
    of 'string:*').
    Notice, that the grammar of different languages may imply a reordering,
    so the above string becomes the german 'wollen Sie %1 wirklich löschen';
    so using percent-placeholders is much better than simple concatenations of
    arguments to the question.

    More languages can be added later without any change in the code,
    recompilation or the like. 
    Even by people without access to the source code i.e. which only have the 
    applications binary.

    Also, unsupported languages' strings are simply left unchanged - if you
    write your application in (say) english, and only plan to use it in english,
    no additional work is required (i.e you dont need a resource file then).
    Strings for unknown languages will come in english 
    (which is better than nothing or empty button labels ;-)

    Summary:
	in subclasses of View and ApplicationModel,
	instead of writing:

		...
		b := Button label:'press me'
		...

	always write:

		...
		b := Button label:(resources string:'press me')
		...

	if your class is not a subclass of one of the above, AND you need
	resource translations, you wont inherit the resources variable
	(which is automatically initialized).
	In this case, you have to ask the ResourcePack class explicitely for
	a corresponding package:

		ResourcePack for:aClassName

	as an example, see how the Date class gets the national names of
	week & monthnames.

    [author:]
	Claus Gittinger
"
!

examples
"
    normally, resources are found in files named after their classes sourcefile
    For example, the FileBrowsers resources are found in 'FBrowser.rs'.
    For the examples below, we process resources from a constant string;
	this is NOT representative.
									[exBegin]
	|stream res|

	stream := ReadStream on:'
foo  ''the translation for foo''
#if Language == #de
bar  ''die deutsche uebersetzung von bar''
baz  ''baz hat den Wert %1''
#endif
#if Language == #fr
bar  ''bar en francaise''
baz  ''%1, c''''est baz''
#endif

'.

	res := ResourcePack new readFromResourceStream:stream in:nil.

	Transcript showCR:'baz is translated to: ' , (res string:'baz' with:'1234').
	Transcript showCR:'bar is translated to: ' , (res string:'bar').
	Transcript showCR:'foo is translated to: ' , (res string:'foo').
	Transcript showCR:'fooBar is translated to: ' , (res string:'fooBar').
									[exEnd]
    set the Language to french:
									[exBegin]
	Language := #fr
									[exEnd]
    and repeat the above.
    back to english:
									[exBegin]
	Language := #en 
									[exEnd]
    back to german:
									[exBegin]
	Language := #de 
									[exEnd]
"
! !

!ResourcePack class methodsFor:'initialization'!

flushCachedResourcePacks
    "forget all cached resources - needed after a style change"

    Packs := nil.
    self initialize

    "ResourcePack flushCachedResourcePacks"
!

initialize
    Packs isNil ifTrue:[
	Packs := WeakArray new:30
    ].

    "ResourcePack initialize"
! !

!ResourcePack class methodsFor:'instance creation'!

for:aClass
    "get the full resource definitions for aClass (i.e. with super packs).
     Also leave the resulting pack in the cache for faster access next time."

    |nm pack superPack pkg prj prjDir baseName path|

    nm := aClass resourcePackName.
    pack := self searchCacheFor:nm.
    pack notNil ifTrue:[^ pack].

    baseName := (Smalltalk fileNameForClass:nm) , '.rs'.

    "/ search in the classes package directory first ...
    prjDir := Smalltalk projectDirectoryForClass:aClass.

    (prjDir notNil 
    and:[(prjDir := prjDir asFilename) exists
    and:[(prjDir := prjDir construct:'resources') exists
    and:[(prjDir construct:baseName) exists]]]) ifTrue:[
	pack := self fromFile:baseName directory:prjDir pathName.
    ] ifFalse:[
	pack := self fromFile:baseName.
    ].
    aClass == Object ifFalse:[
	pack superPack:(self for:(aClass superclass)).
    ].
    pack packsClassName:nm.
    self addToCache:pack.
    ^ pack

    "
     ResourcePack for:TextView     
     ResourcePack for:CodeView
     ResourcePack for:Workspace  
     ResourcePack for:View      
     ResourcePack for:ErrorLogger 
     ResourcePack for:NewLauncher 
     Workspace classResources
    "

    "Modified: / 29.1.1998 / 22:42:53 / cg"
!

fromFile:aFileName
    "get the resource definitions from a file in the default directory.
     Uncached low-level entry."

    ^ self fromFile:aFileName directory:'resources'

    "
     ResourcePack fromFile:'SBrowser.rs'
     ResourcePack fromFile:'FBrowser.rs'
     ResourcePack fromFile:'Smalltalk.rs'
     ResourcePack fromFile:'Smalltalk.rs' asFilename
    "
!

fromFile:aFileName directory:dirName
    "get the resource definitions from a file in a directory.
     Uncached low-level entry."

    |newPack|

    newPack := self new.
    newPack readFromFile:aFileName directory:dirName.
    ^ newPack
! !

!ResourcePack class methodsFor:'private'!

addToCache:aPack
    |idx|

    idx := Packs identityIndexOf:nil.
    idx == 0 ifTrue:[
	idx := Packs identityIndexOf:0
    ].
    idx == 0 ifTrue:[
	"
	 throw away oldest
	"
	idx := Packs size.
	Packs replaceFrom:1 to:idx-1 with:Packs startingAt:2.
    ].
    Packs at:idx put:aPack
!

searchCacheFor:aClassname
    |sz "{ Class: SmallInteger }" |

    Packs isNil ifTrue:[
	self initialize.
	^ nil
    ].

    sz := Packs size.
    1 to:sz do:[:idx |
	|aPack|

	aPack := Packs at:idx.
	(aPack notNil 
	and:[aPack ~~ 0]) ifTrue:[
	    aClassname = aPack packsClassName ifTrue:[
		"
		 bring to end for LRU
		"
		Packs replaceFrom:idx to:sz-1 with:Packs startingAt:idx+1.
		Packs at:sz put:aPack.
		^ aPack
	    ]
	]
    ].
    ^ nil

    "
     ResourcePack searchCacheFor:'TextView' 
    "
! !

!ResourcePack methodsFor:'accessing'!

array:anArray
    "translate a collection of strings"

    ^ anArray collect:[:r | self at:r default:r]

    "
     Launcher classResources array:#('file' 'classes') 
    "

    "Modified: / 29.1.1998 / 22:44:22 / cg"
!

at:aKey
    "translate a string"

    ^ self at:aKey ifAbsent:aKey
!

at:aKey default:default
    "translate a string"

    ^ self at:aKey ifAbsent:default
!

at:aKey ifAbsent:defaultValue
    "translate a string"

    |val alternativeKey|

    aKey notNil ifTrue:[
	val := super at:aKey ifAbsent:nil.
	val notNil ifTrue:[^ val].

	"/ try with case-first swapped...
	(aKey isString 
	and:[aKey size > 0
	and:[aKey first isLetter]]) ifTrue:[
	    alternativeKey := aKey first isUppercase 
				ifTrue:[aKey asLowercaseFirst]
				ifFalse:[aKey asUppercaseFirst].
	    val := super at:alternativeKey ifAbsent:nil.
	    val notNil ifTrue:[
		aKey first isUppercase 
		    ifTrue:[^val asUppercaseFirst].
		^ val asLowercaseFirst.                
	    ].
	].

	superPack notNil ifTrue:[
	    ^ superPack at:aKey ifAbsent:defaultValue.
	].
    ].
    ^ defaultValue value

    "Modified: / 16.11.2001 / 12:25:33 / cg"
!

name:aKey default:default
    "translate a string.
     Obsolete - use #string:default:"

    ^ self at:aKey ifAbsent:default
!

string:s
    "translate (retrieve) a string - if not present, return s"

    ^ self at:s ifAbsent:s

    "
     NewLauncher classResources
	string:'LICENCEFILE' 
    "
!

string:s default:defaultString
    "translate (retrieve) a string - if not present, return defaultString"

    ^ self at:s ifAbsent:defaultString

    "
     NewLauncher classResources
	string:'fooBar' default:'Hello world'  
    "

!

string:s default:defaultString with:arg
    "translate and expand arg"

    ^ self string:s default:defaultString withArgs:(Array with:arg)

    "
     NewLauncher classResources
	string:'%1 fooBar' default:'Hello %1' with:'foo' 
    "

!

string:s default:defaultString with:arg1 with:arg2
    "translate and expand args"

    ^ self string:s default:defaultString withArgs:(Array with:arg1 with:arg2)
!

string:s default:defaultString with:arg1 with:arg2 with:arg3
    "translate and expand args"

    ^ self string:s default:defaultString withArgs:(Array with:arg1 with:arg2 with:arg3)

    "Created: 9.12.1995 / 19:08:50 / cg"
!

string:s default:defaultString with:arg1 with:arg2 with:arg3 with:arg4
    "translate and expand args"

    ^ self string:s default:defaultString withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4)

    "Created: 9.9.1996 / 18:52:14 / cg"
!

string:s default:defaultString withArgs:argArray
    "translate and expand args"

    |template|

    template := self at:s ifAbsent:defaultString.
    ^ template expandPlaceholdersWith:argArray
!

string:s with:arg
    "translate and expand arg"

    ^ self string:s withArgs:(Array with:arg)
!

string:s with:arg1 with:arg2
    "translate and expand args"

    ^ self string:s withArgs:(Array with:arg1 with:arg2)
!

string:s with:arg1 with:arg2 with:arg3
    "translate and expand args"

    ^ self string:s withArgs:(Array with:arg1 with:arg2 with:arg3)

    "Created: 9.12.1995 / 19:08:50 / cg"
!

string:s with:arg1 with:arg2 with:arg3 with:arg4
    "translate and expand args"

    ^ self string:s withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4)

    "Created: 9.9.1996 / 18:52:14 / cg"
!

string:s with:arg1 with:arg2 with:arg3 with:arg4 with:arg5
    "translate and expand args"

    ^ self string:s withArgs:(Array with:arg1 with:arg2 with:arg3 with:arg4 with:arg5)

!

string:s withArgs:argArray
    "translate and expand args"

    |template|

    template := self at:s ifAbsent:s.
    ^ template expandPlaceholdersWith:argArray
! !

!ResourcePack methodsFor:'accessing-internals'!

name:aKey
    "translate a string"

    ^ self at:aKey ifAbsent:aKey
!

packsClassName
    ^ packsClassName
!

packsClassName:aString
    packsClassName := aString
!

superPack:anotherResourcePack
    superPack := anotherResourcePack

    "Created: / 29.1.1998 / 22:43:09 / cg"
! !

!ResourcePack methodsFor:'file reading'!

fileReadFailed
    "return true, if the pack does not really contain
     valid translations, since the fileRead failed.
     However, all inherited translations are still available
     through the receiver"

    ^ fileReadFailed ~~ false

    "Created: / 14.5.1996 / 10:19:26 / cg"
    "Modified: / 29.1.1998 / 22:46:38 / cg"
!

nonexistingFileRead
    "asked to read definitions for a non-existing file.
     Here, this is legal and ignored (typically using inherited resources).
     However, subclasses (such as styleSheet) may flag it as an error."

    ^ nil

    "Created: 6.9.1997 / 11:38:53 / cg"
!

processLine:aLine encoding:encoding file:fileName
    "process a single valid line (i.e. #ifdef & #include has already been processed)"

    |lineString name stream l rest macroName value 
     conditional hasError|

    lineString := aLine withoutSeparators.
    name := nil.
    (lineString at:1) == $' ifTrue:[
        stream := ReadStream on:lineString.
        stream signalAtEnd:false.
        name := String 
                    readFrom:stream 
                    onError:[('ResourcePack [warning]: invalid line <'
                             ,lineString
                             ,'> in file:'
                             , fileName
                            ) errorPrintCR. nil].
"/ OLD: l := stream position
        l := stream position1Based + 1.

"/                          l := lineString indexOf:$' startingAt:2.
"/                          l ~~ 0 ifTrue:[
"/                              name := (lineString copyFrom:2 to:l-1).
"/                              l := l + 1
"/                          ]
    ] ifFalse:[
        l := lineString indexOfSeparatorStartingAt:1.
        l ~~ 0 ifTrue:[
            name := lineString copyFrom:1 to:l-1.
        ]
    ].
    name notNil ifTrue:[
        hasError := false.

        rest := (lineString copyFrom:l) withoutSeparators.
        "
         skip <type> if present
        "
        (rest startsWith:$<) ifTrue:[
             l := lineString indexOf:$> startingAt:l.
             rest := (lineString copyFrom:l+1) withoutSeparators.
        ].

        conditional := false.
        (rest startsWith:$?) ifTrue:[
            rest := (rest copyFrom:2) withoutSeparators.
            conditional := true.
        ].

        (rest startsWith:$=) ifTrue:[
            rest := rest copyFrom:2.
            stream := ReadStream on:rest.
            macroName := stream nextAlphaNumericWord.
            [stream peek == $.] whileTrue:[
                stream next.
                stream peek notNil ifTrue:[
                    macroName := macroName , '.' , (stream nextAlphaNumericWord)
                ]
            ].
            rest := stream upToEnd.
            value := self at:macroName ifAbsent:nil.
            (value isNil) ifTrue:[
                hasError := true.
                ('ResourcePack [warning]: bad (nil-valued) macro: ' , macroName) errorPrintCR.
                ('ResourcePack [warning]: in line: ' , lineString) errorPrintCR.
                ('ResourcePack [warning]: in file: ' , fileName) errorPrintCR.
            ].
            value isBlock ifTrue:[
                value := value value
            ].
            value := Compiler evaluate:('self ' , rest)
                              receiver:value
                              notifying:nil
                              compile:false.
            (value == #Error) ifTrue:[
                hasError := true.
                ('ResourcePack [warning]: error in line: "self ' , rest , '"') errorPrintCR.
                ('ResourcePack [warning]: in file: ' , fileName) errorPrintCR.
            ]
        ] ifFalse:[
            value := Compiler evaluate:rest compile:false.
            (value == #Error) ifTrue:[
                hasError := true.
                ('ResourcePack [warning]: error in line: "' , rest , '"') errorPrintCR.
                ('ResourcePack [warning]: in file: ' , fileName) errorPrintCR.
            ] ifFalse:[
                encoding notNil ifTrue:[
                    value isString ifTrue:[
                        value := value decodeFrom:encoding
                    ]
                ]
            ]
        ].
        hasError ifFalse:[
            (conditional not
            or:[(self includesKey:name) not]) ifTrue:[
                self at:name put:value.
            ]
        ]
    ]

    "Created: / 30.8.1998 / 12:35:37 / cg"
    "Modified: / 28.4.1999 / 22:23:14 / cg"
!

readFromFile:fileName directory:dirName
    "read definitions from a file in a directory"

    |inStream ok|

    fileReadFailed := false.
    dirName = 'resources' ifTrue:[
        inStream := Smalltalk resourceFileStreamFor:fileName
    ] ifFalse:[
        inStream := Smalltalk 
                        systemFileStreamFor:(dirName 
                                                isNil ifTrue:[fileName]
                                                ifFalse:[dirName asFilename construct:fileName]).
    ].
    inStream isNil ifTrue:[
        "
         an empty pack
        "
        ^ self nonexistingFileRead
    ].

    ok := self readFromResourceStream:inStream in:dirName.
    inStream close.

    ok ifFalse:[
        fileReadFailed := true.

        ('ResourcePack [warning]: ''' , inStream pathName , ''' contains error(s) - data may be incomplete.') errorPrintCR.
    ].

    "Modified: 10.1.1997 / 18:05:17 / cg"
!

readFromResourceStream:inStream in:dirName
    "read definitions from a stream. THe dirName argument is required to
     specify where #include files are searched for.
     Return true, if the style sheet could be read without errors, false otherwise."

    |lineString l lNo rest value ifLevel skipping first ok encoding pack errorHandler|

    encoding := nil.

    ok := true.
    ifLevel := 0.
    skipping := false.
    lNo := 0.

    errorHandler := [:ex | 
			|con|

			('ResourcePack [warning]: ''' , ex errorString , '''') errorPrintCR.
			('ResourcePack [info]: file: ' , inStream pathName printString , ' line: ' , lNo printString , ': ''' , lineString , '''') errorPrintCR.
			con := ex suspendedContext.
			('ResourcePack [info]: in: ' , con fullPrintString) errorPrintCR.
			con := con sender.
			('ResourcePack [info]:   : ' , con fullPrintString) errorPrintCR.
			con := con sender.
			('ResourcePack [info]:   : ' , con fullPrintString) errorPrintCR.
			value := nil.
			ok := false.
		    ].

    [inStream atEnd] whileFalse:[
	lineString := inStream nextLine. lNo := lNo + 1.
	[lineString notNil and:[lineString endsWith:$\]] whileTrue:[
	    lineString := lineString copyWithoutLast:1.
	    l := inStream nextLine. lNo := lNo + 1.
	    l notNil ifTrue:[
		lineString := lineString , l.
	    ].
	].

	(lineString size > 0) ifTrue:[
	    first := lineString at:1.
	    "/
	    "/ for your convenience: treat ; AND "/ as comment-line
	    "/
	    ((first == $;) or:[lineString startsWith:'"/']) ifFalse:[
		first == $# ifTrue:[
		    "/ a directive
		    lineString := (lineString copyFrom:2) withoutSpaces.

		    (lineString startsWith:'if') ifTrue:[
			skipping ifFalse:[
			    rest := lineString copyFrom:3.
			    ErrorSignal 
				handle:errorHandler 
				do:[
				    value := Compiler evaluate:rest compile:false].
			    (value == #Error) ifTrue:[
				('ResourcePack [warning]: error in resource:' , lineString) errorPrintCR.
			    ].
			    (value == false) ifTrue:[
				skipping := true
			    ]
			].
			ifLevel := ifLevel + 1
		    ] ifFalse:[
			(lineString startsWith:'endif') ifTrue:[
			    ifLevel := ifLevel - 1.
			    ifLevel == 0 ifTrue:[
				skipping := false
			    ]
			] ifFalse:[
			    (lineString startsWith:'else') ifTrue:[
				skipping := skipping not
			    ] ifFalse:[
				skipping ifFalse:[
				    (lineString startsWith:'include') ifTrue:[
					(lineString startsWith:'includeResourcesFor') ifTrue:[
					    "/ include those resources ...
					    rest := lineString copyFrom:('includeResourcesFor' size + 1).
					    value := Compiler evaluate:rest compile:false.
					    value isBehavior ifTrue:[
						pack := self class for:value.
						pack notNil ifTrue:[
						    self declareAllFrom:pack.
						]
					    ]
					] ifFalse:[
					    rest := lineString copyFrom:('include' size + 1).
					    value := Compiler evaluate:rest compile:false.
					    value isString ifFalse:[
						('ResourcePack [warning]: bad include filename: ' , value printString) errorPrintCR.
						('ResourcePack [info]: line ' , lNo printString , ': ''' , lineString , '''') infoPrintCR.
					    ] ifTrue:[
						self readFromFile:value directory:dirName
					    ]
					]
				    ] ifFalse:[
					(lineString startsWith:'encoding') ifTrue:[
					    rest := lineString copyFrom:9.
					    encoding := rest withoutSeparators asSymbol
					]
				    ]
				]
			    ]
			]
		    ].
		] ifFalse:[
		    skipping ifFalse:[
			ErrorSignal 
			    handle:errorHandler 
			    do:[
				(lineString at:1) == $!! ifTrue:[
				    "/ evaluate the rest
				    Compiler evaluate:(lineString copyFrom:2)
						      receiver:nil
						      notifying:nil
						      compile:false.
				] ifFalse:[
				    "/ process as resource
				    self 
					processLine:lineString 
					encoding:encoding 
					file:(inStream isFileStream 
						ifTrue:[inStream pathName]
						ifFalse:['---'])
				]]
		    ]
		]
	    ]
	]
    ].
    ^ ok

    "Modified: / 31.8.1995 / 02:33:45 / claus"
    "Modified: / 30.8.1998 / 12:35:24 / cg"
! !

!ResourcePack class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview/ResourcePack.st,v 1.75 2003-02-25 11:46:18 cg Exp $'
! !

ResourcePack initialize!