"Initialization code"
 !

"define required class"
Smalltalk at: #String ifAbsent: [
FixedSizeCollection variableByteSubclass: #String
  classVariableNames: ''
  poolDictionaries: 
    ' CharacterConstants ']!

"define required class"
Smalltalk at: #SortedCollection ifAbsent: [
OrderedCollection subclass: #SortedCollection
  instanceVariableNames: 
    ' sortBlock '
  classVariableNames: ''
  poolDictionaries: '']!

"define required class"
Smalltalk at: #HelpManager ifAbsent: [
Object variableSubclass: #HelpManager
  instanceVariableNames: 
    ' applicationWindow helpInstance aboutDlgClass extHelpPanelId keysHelpPanelId helpInit helpTableId helpTableModule helpWindowTitle helpLibraryPath pmHelpLibrary addresses dialogs '
  classVariableNames: ''
  poolDictionaries: 
    ' PMConstants PMHelpConstants ']!

"define required class"
Smalltalk at: #ApplicationWindow ifAbsent: [
Window subclass: #ApplicationWindow
  instanceVariableNames: 
    ' label collapsed menuWindow dependents activeTextPane '
  classVariableNames: ''
  poolDictionaries: 
    ' PMHelpConstants PMConstants ']!

"define required class"
Smalltalk at: #DialogTopPane ifAbsent: [
TopPane subclass: #DialogTopPane
  instanceVariableNames: 
    ' sem pmOwner '
  classVariableNames: 
    ' FrameTemplate '
  poolDictionaries: 
    ' CharacterConstants PMConstants ']!

"define required class"
Smalltalk at: #DialogBox ifAbsent: [
Window subclass: #DialogBox
  instanceVariableNames: 
    ' mp1 mp2 sem '
  classVariableNames: ''
  poolDictionaries: 
    ' PMHelpConstants PMConstants CharacterConstants ']!

"define required class"
Smalltalk at: #SubPane ifAbsent: [
Window subclass: #SubPane
  instanceVariableNames: 
    ' handlers margin topCorner framingBlock curFont menu popup '
  classVariableNames: ''
  poolDictionaries: 
    ' PMHelpConstants PMConstants ']!

"define required class"
Smalltalk at: #StaticGraphic ifAbsent: [
StaticPane subclass: #StaticGraphic
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: 
    ' PMConstants ']!



!String methods !
   
fileExtension
		"Answer a character String that follows the receiver's 
		last period character."
		"@08.05.94 ch: don't require 3 character extensions (e.g. HPFS)"  
	self size to: 1 by: -1 do: [:i |
		(self at: i) = $. ifTrue: [^self copyFrom: i+1 to: self size]].
	^String new! !



!String class methods ! !



!SortedCollection methods !

collect: aBlock
        "For each element in the receiver, evaluate aBlock with
         that element as the argument.  Answer a new collection
         containing the results as its elements from the aBlock
         evaluations."
		"@25.02.94 ch: Creation"
    | answer |
    answer := OrderedCollection new.
    self do: [ :element |
        answer add: (aBlock value: element)].
    ^answer!

select: aBlock
        "For each element in the receiver, evaluate
         aBlock with that element as the argument.
         Answer a new collection containing those elements
         of the receiver for which aBlock evaluates to true."
    | answer |
    answer := self class sortBlock: sortBlock.
    self do: [ :element |
        (aBlock value: element)
            ifTrue: [answer add: element]].
    ^answer! !



!SortedCollection class methods ! !



!HelpManager methods !

displayHelp: id
        "Display the help panel identified by id
        id can be either an Integer or a String."
		"@12.02.94 ch: helpmanager bug workaround" 
    id isString
        ifTrue: [
            ^(PMWindowLibrary 
                sendMsg: helpInstance
                msg: HmDisplayHelp
                mp1Struct: id asParameter copy
				"The HelpManager uppercases the string passed in,
				so make a copy to prevent modification."
                mp2: HmPanelname) asPMLong asInteger].
    id isInteger
        ifTrue: [
            ^(PMWindowLibrary 
                sendMsg: helpInstance
                msg: HmDisplayHelp
                mp1: id
                mp2: HmpaneltypeNumber )asPMLong asInteger]! !



!HelpManager class methods ! !



!ApplicationWindow methods !
  
hmHelpsubitemNotFound: mp1 with: mp2
        "Private - Show the appropriate help panel."
		"@19.11.93 ch: Work around for OS/2 bug" 
    | helpLabel helpManager helpMode idTopic idSubTopic menu result |
    helpMode := mp1 shortAtOffset: 0.
    idTopic := mp2 lowHalf.			" menu "
    idSubTopic := mp2 highHalf.	" menu item "
    helpMode = HlpmMenu
        ifTrue: [ idSubTopic = 65535 "Only a submenu but no item is selected."
            ifTrue: [
                self menuWindow menus do: [:menu |
                    ( menu menuItem id = idTopic )
                        ifTrue: [ helpLabel := menu title ]]]
            ifFalse: [
                menu := self menuWindow menuOf: idSubTopic.
                menu == (self menuWindow menuOf: idTopic)
                    ifTrue: [ helpLabel := ( menu selectorOf: idSubTopic ) asString ]
                    ifFalse: [ helpLabel := menu title ] ] ]
        ifFalse: [
            ((helpMode = HlpmFrame or: [helpMode = HlpmWindow])
            and: [children size >= idSubTopic])
                ifTrue: [helpLabel := (self childAtId: idSubTopic) name asParameter]].

    (helpManager := self helpManager) isNil 
        ifTrue: [helpManager := self pmOwner helpManager].
    (helpLabel isNil or: [helpManager isNil])
		ifTrue: [^false].
	^(helpManager displayHelp: helpLabel) = 0!
 
labelWithoutPrefix: aString
        "Set the window label of the receiver to aString
        without prepending 'Smalltalk/V '."
		"@06.11.93 ch : the window list was not updated" 
    label := aString. 
    label size > 500 ifTrue: [label := label copyFrom: 1 to: 500].
        "Experimentally determined that labels more than 500 bytes
         cause PM to mess up the title bar."
    handle isNil ifTrue: [^self].
    handle isValid ifTrue: [
        parent handle setWindowText: label;
        changeSwitchEntry: label ].! !



!ApplicationWindow class methods ! !



!DialogTopPane methods !
 
buildItems
        "Private - Build the control items within
         the dialog box.  Answer a ByteArray
        containing all the items."
		"@18.12.93 ch: inset the rectangle for childs, so they do not override the 
		border"  
    | answer items subpaneStyle rect text pmDlgItem strings stringsOffset
    offText cchClassName offClassName|
    answer := ByteArray new.
    strings := ByteArray new.
    items := OrderedCollection new.
    stringsOffset := 14 + 30 + (30 * children size).
    children do: [ :subpane |
        subpane style isNil ifTrue: [subpane style: subpane defaultStyle].
        ( subpane propertyAt: #noTabStop ) isNil ifTrue: [
            subpane addStyle: WsTabstop ].
        (subpane isKindOf: SubPane) ifTrue: [
            ((rect := subpane framingBlock) isKindOf: Context)
                ifTrue: [rect := rect value: 
					((0@0 extent: rectangle extent) insetBy: 2 @ 0)].
            text := (subpane respondsTo: #contents) 
                ifTrue: [subpane contents] 
                ifFalse: [nil].
            text class = String ifFalse:[
                text := nil].
            pmDlgItem := SelfDefinedStructure named: 'DLGTITEM'.
            offText := stringsOffset + strings size.
            text isNil ifFalse: [strings := strings, text asAsciiZ].
            (subpane windowClass isKindOf: String) 
                ifTrue: [
                    offClassName := stringsOffset + strings size.
                    cchClassName := subpane windowClass asAsciiZ size.
                    strings := strings, subpane windowClass asAsciiZ]
                ifFalse: [cchClassName := 0.
                    offClassName := subpane windowClass].
            items add: (
                pmDlgItem
                    cChildren: 0;
                    cchClassName: cchClassName;
                    offClassName: ( offClassName bitAnd: 16rFFFF );
                    cchText: text size;
                    offText: offText;
                    flStyle: WsVisible |  subpane style;
                    x: rect left asInteger;
                    y: rect bottom asInteger;
                    cx: rect width asInteger;
                    cy: rect height asInteger;
                    windowId: subpane getId ).
            subpane pmControlData notNil ifTrue: [
                pmDlgItem offCtlData: stringsOffset + strings size.
                strings := strings, subpane pmControlData contents ] ] ].
    items do: [:pmDlgItem | 
        answer := answer , pmDlgItem contents].
    ^answer , strings! !



!DialogTopPane class methods ! !



!DialogBox methods ! !



!DialogBox class methods !
  
parseDotHFile: aFileName
        "Create a method in the receiver (class)
         which initializes the ItemIds
         class variable to contain a Dictionary of
         mappings from item ids to item names (symbols)
         and vice versa. aFileName is .h file
         created by the Dialog Box Editor."
		"24.4.94 Bug fix: use pathNameReadOnly."
    | file key id method |
    file := File pathNameReadOnly: aFileName.
    method := (String new: 50) asStream.
    method nextPutAll: 'initItemIds'.
    method cr; nextPutAll: '    ItemIds := Dictionary new.'; cr.
    [file atEnd] whileFalse: [
        (file next = $# and: [file next = $d])
            ifTrue: [
                file skipTo: Space.
                key := file upTo: Space.
                id := (file upTo: Cr) trimBlanks.
                method
                    nextPutAll: '    ItemIds at: '; nextPutAll: id;
                    nextPutAll: ' put: #'; nextPutAll: key;
                    nextPut: $.; cr;
                    nextPutAll: '    ItemIds at: '; nextPut: $';
                    nextPutAll: key; nextPut: $';
                    nextPutAll: ' put: '; nextPutAll: id;
                    nextPut: $.; cr.
                file skipTo: Lf]
            ifFalse: [file skipTo: Lf]].
    file close.
    (self classVarNames includes: 'ItemIds') ifFalse: [
        self addClassVarName: 'ItemIds'].
    method := method contents.
    (self class compile: method) isNil
        ifTrue: [^false]
        ifFalse: [
            Smalltalk
                logSource: method
                forSelector: #initItemIds
                inClass: self class].! !



!SubPane methods !

menu
        "Private - Answer the menu for the pane."
		"@11.05.94 ch: giving the menu in the menu variable causes problems with 
		popups, so always get a new menu." 
		"@27.04.94 ch: bug fix: changed owner, prevent 
		multiple #getMenu raises" 

    (owner isNil or: [(self handlesEvent: #getMenu) not]) ifTrue: [^nil].
    self event: #getMenu.
	(menu notNil and: [menu owner isNil]) ifTrue: [
		Transcript cr; nextPutAll: 'Warning, no owner in for menu ', menu title.
		menu owner: self owner].
	^menu

	"The next lines causes irratic behaviour if the
	application sets another owner than itsself.
	It will break no code in the system, as all Classes 
	set the owner in the #getMenu event. Unfortunately
	this line sets the owner back."
    "menu isNil ifTrue: [^nil].
    menu owner: owner.
    ^menu"! !



!SubPane class methods ! !



!StaticGraphic methods !
   
setHandle
        "Private - Set the icon or bitmap handle for the static control."
		"@16.12.93 ch: bug fix: the 'self resize:' statements causes wrong 
		positioning" 
        " Assumes 'handle = NullHandle' is false and value is either
          an icon or bitmap handle." 
    value notNil
    ifTrue: 
        [ PMWindowLibrary sendMsg: ( self handle )
            msg: SmSethandle mp1: value handle asParameter mp2: 0.
"		self invalidateRect: self rectangle. "
		
		"This MUST NOT be done. It causes a wrong position of the graphic."
        "self resize: self rectangle."		     	" force redraw..."
        ]! !



!StaticGraphic class methods ! !
"Finalization code"
  !

 
Transcript cr; nextPutAll: 'Bug Fixes 2.0 installed.'!
