"Initialization code"
 !

"define required class"
Smalltalk at: #Behavior ifAbsent: [
Object subclass: #Behavior
  instanceVariableNames: 
    ' superClass dictionaryArray structure name comment subclasses instances '
  classVariableNames: 
    ' InstNumberMask InstIndexedBit InstPointerBit InstZeroTerminatedBit '
  poolDictionaries: 
    ' PMConstants ']!

"define required class"
Smalltalk at: #Class ifAbsent: [
Behavior subclass: #Class
  instanceVariableNames: 
    ' classPool sharedPools '
  classVariableNames: ''
  poolDictionaries: '']!

"define required class"
Smalltalk at: #SystemDictionary ifAbsent: [
Dictionary subclass: #SystemDictionary
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: 
    ' CharacterConstants PMConstants ']!

"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: #DictionaryInspector ifAbsent: [
Inspector subclass: #DictionaryInspector
  instanceVariableNames: ''
  classVariableNames: ''
  poolDictionaries: '']!

"define required class"
Smalltalk at: #MethodBrowser ifAbsent: [
ViewManager subclass: #MethodBrowser
  instanceVariableNames: 
    ' methods selectedMethod positions highlightLiteral methodPane '
  classVariableNames: ''
  poolDictionaries: '']!

"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: #TextPane ifAbsent: [
TextEdit subclass: #TextPane
  instanceVariableNames: 
    ' evaluate modified '
  classVariableNames: 
    ' Forward NewString LeftBrackets SearchString RightBrackets CaseSensitive PriorCommand UndoBuffer '
  poolDictionaries: 
    ' CharacterConstants PMConstants ']!



!Behavior methods !

removeSelector: aSymbol
        "Remove the method named aSymbol from
         the methods defined in the receiver."
		"@07.11.93 ch: remove the method from all application also"
	aSymbol = #Doit ifFalse: [ 
		ChApplication removeMethod: aSymbol forClass: self].
    self methodDictionary
        removeKey: aSymbol
        ifAbsent: []! !



!Behavior class methods ! !



!Class methods !
  
removeFromSystem
        "Remove the receiver from Smalltalk.  Report
         an error if there are any subclasses or
         instances of the receiver."
		"@07.11.93 ch: Remove the class from all applications" 
	ChApplication removeClass: self.
    ^self removeFromSystem: true.! !



!Class class methods ! !



!SystemDictionary methods !
   
compressChanges
        "Build a new change log file retaining
         only the latest version of changed
         methods in the current change log.
         Save the image to the image file."
		"@21.02.94 ch: log class comments too" 
    | logDirectory stream tempLogName dialog answer classSource |
    BackupImage ifTrue: [  ( answer := self backupChanges ) ~= 0 ifTrue: [ ^DosDLL OS2Error: answer ] ].
    dialog := DialogBox new fromModule: VPMVM id: 100.
    dialog showWindow.
    logDirectory := (Sources at: 2) file directory.
    stream := logDirectory newFile: 'ChangLog.tmp'.
    stream lineDelimiter: Cr.
    tempLogName := stream pathName.
    self getSourceClasses do: [ :class |
		class dll = 0 ifTrue: [
			"file out the class definition"
			classSource := WriteStream on: (String new: 100).
			class fileOutOn: classSource.
			stream cr; cr; nextPutAll: '"define class"';
				nextChunkPut: classSource contents].
		].
    self getSourceClasses do: [ :class |
        self compressChangesOf: class class into: stream.
        self compressChangesOf: class into: stream].
    self getSourceClasses do: [ :class |
		(ChApplication classCommentOf: class) notEmpty ifTrue: [
			stream cr; cr; nextPutAll: 'ChApplication setClassCommentOf: ',
		        class name, ' to: ', (String with: 10 asCharacter);
				nextChunkPut: (ChApplication classCommentOf: class) printString].
		].
    stream close.
    ( self removeFile: 2 dialog: dialog )
        ifFalse: [ 
            File remove: tempLogName ifAbsent: [ ].
            ^self ].
    File
        rename: tempLogName
        to: (Sources at: 2) pathName.
    Sources
        at: 2
        put: (logDirectory file: (Sources at: 2) file name).
    (Sources at: 2) lineDelimiter: Cr.
    Transcript saveImageNoConfirm.
    dialog close! !



!SystemDictionary class methods ! !



!HelpManager methods !
 
about
        "Private - Open a dialog window to show the product 
        information."
		"@19.12.93 ch: added the #openAboutDialog feature" 
	(aboutDlgClass respondsTo: #openAboutDialog)
		ifTrue: [aboutDlgClass perform: #openAboutDialog]
		ifFalse: [aboutDlgClass new open]! !



!HelpManager class methods ! !



!DictionaryInspector methods !
   
inspectMenu: pane
        "Private - Set the dictionary
         inspector list pane menu."
		"@11.05.94 ch: added #sendersOfSelection" 
    | menu |
    menu := (Menu 
        labels: '~Inspect\~Add\~Senders\~Remove' withCrs
        lines: Array new
        selectors: #(inspectSelection add sendersOfSelection remove))
            title: '~Dictionary';
            owner: self;
            yourself.
    menu disableItem: #inspectSelection.
    pane setMenu: menu!
 
sendersOfSelection
        "Private - Open a method browser on the senders
        of the selected association."
		"@11.05.94 ch" 
    instIndex isNil
        ifTrue: [^self].
    Smalltalk sendersOf: (object associationAt: (instList at: instIndex) key)!

sendersOfVariable
        "Private - Open a method browser on the senders
        of the selected association."
    instIndex isNil
        ifTrue: [^self].
    Smalltalk sendersOf: (object associationAt: (instList at: instIndex) key)! !



!DictionaryInspector class methods ! !



!MethodBrowser methods !

accept: textPane
        "Private - Accept the contents of textPane as an updated
         method and compile it.  Notify textPane if
         the compiler detects errors."
		"@07.11.93 ch: added the option to supply a method comment" 
    | result class aString |
    aString := textPane contents.
    class := selectedMethod classField.
    result := class
        compile: aString
        notifying: textPane.
    result isNil
        ifTrue: [ ^textPane modified: true ]
        ifFalse: 
            [
			aString := ChApplication insertMethodCommentIn: aString
				method: result key forClass: class.
            Smalltalk
                logSource: aString
                forSelector: result key
                inClass: class.
            result key == selectedMethod selector
                ifTrue: [ self updateMethods: result ]
                ifFalse: [ self addNewMethod: result ].
			self changed: #text:.
            ^textPane modified: false
            ]!
 
addToApplication
		"Private - Ask the user to supply an application where to add 
		the selected method."
		"@06.11.93 ch"   
    selectedMethod isNil
        ifFalse: [ChApplication addToApplicationMethod: selectedMethod selector
			forClass: selectedMethod classField]!
   
disableMethodsMenu
        "Private - Disable the methods menu."
		"@06.11.93 ch"  
    (self menuTitled: '~Methods')
        disableItem: #removeSelector;
		disableItem: #addToApplication;
        disableItem: #senders;
        disableItem: #implementors;
        disableItem: #localSenders;
        disableItem: #localImplementors;
        disableItem: #messages!
 
enableMethodsMenu
        "Private - Enable the methods menu."
		"@06.11.93 ch"  
    (self menuTitled: '~Methods')
        enableItem: #removeSelector;
		enableItem: #addToApplication;
        enableItem: #senders;
        enableItem: #implementors;
        enableItem: #localSenders;
        enableItem: #localImplementors;
        enableItem: #messages!
  
listMenu: listPane
        "Private - Set the list pane menu."
		"@11.05.94 ch: Use ChMenu" 
		"@06.11.93 ch" 
		"@13.08.93 ch " 
    listPane setMenu: ((ChMenu
        labels: '~Remove From List/System\~Add to Application\~Senders\~Implementors\Local Senders\Local Implementors\~Messages' withCrs
        lines: #(2)
        selectors: #(removeSelector addToApplication senders implementors localSenders localImplementors messages))
            title: '~Methods';
            owner: self;
            yourself)!
 
openOn: aMethodCollection 
        "Create a method browser window on
         aMethodCollection"
		"@11.05.94 ch" 
		"@14.12.93 ch: Ask for a user comment" 
    | ratio |
    aMethodCollection isEmpty ifTrue: [
        ^MessageBox message: 'No methods found'].
    ratio := 2 / 5.
    methods := aMethodCollection asOrderedCollection.
    self addSubpane:
        (ListPane new
            owner: self;
            when: #getContents perform: #methodList: ;
            when: #getMenu perform: #listMenu: ;
            when: #select perform: #method:;
            framingRatio:
                (Rectangle leftTopUnit
                    extentFromLeftTop: (1 @ ratio))).
    self addSubpane:
        (methodPane := TextPane new
            owner: self;
            when: #getContents perform: #text: ;
            when: #save perform: #accept: ;
            framingRatio:
                ((Rectangle leftTopUnit rightAndDown:  0 @ ratio)
                    extentFromLeftTop: 1@(1 - ratio))).
    self openWindow;
        disableMethodsMenu!
 
removeSelector
		"Private - Remove selected method. Ask if the method should 
		be removed from the system or just from the list."
		"@13.08.93 ch : Added the option to remove the method from 
		the system"  
	| result |
    selectedMethod isNil ifTrue: [^self].
	result := MessageBox confirmWithCancelDefaultNo: 
		'Remove the method from the system also?'.
	result isNil ifTrue: [^self].
	methods remove: selectedMethod.
	result ifTrue: [
		ChApplication removeMethod: selectedMethod selector 
			forClass: selectedMethod classField.
	    selectedMethod classField removeSelector: 
			selectedMethod selector.
		Smalltalk logEvaluate: selectedMethod classField name, 
			' removeSelector: #', selectedMethod selector].
	self
		changed: #methodList:
        	with: #restore.
	selectedMethod := nil.
	self changed: #text:.! !



!MethodBrowser class methods ! !



!ApplicationWindow methods !
 
openChangeBrowser
		"Private - The user selected Browser Changes from the 
		File menu."
		"@07.05.94 ch: use ChChangeBrowser>>open" 
		"@25.02.94 ch: use ChFileDialog" 
		"@05.02.94 ch" 
	ChChangeBrowser new open!

openChApplicationBrowser
		"Private - The user selected Browse Applications from the 
		File menu."
		"@06.11.93 ch"   
    ChApplicationBrowser new open.!
 
openIPFBrowser
		"Private - The user selected 'Edit IPF Files' from the File 
		menu." 
		"@12.02.94 ch: Creation"  
    ChIPFBrowser new open.!

openLibraryBuilder
		"Private - The user selected Build Libraries from the File 
		menu."
		"@12.02.94 ch: Creation"  
    ChLibraryBuilder new open.! !



!ApplicationWindow class methods !
  
fileMenu
        "Private - Answer the File menu."
		"@25.02.94 ch" 
		"@12.02.94 ch: added openLibraryBuilder" 
		"@16.08.93 ch : Added ChangeBrowser" 
    ^Menu new
        appendItem: '~New Workspace	Alt+N' selector: #openWorkspace accelKey: $n accelBits: AfAlt | AfChar ;
        appendItem: '~Open...	Alt+O' selector: #openFile accelKey: $o accelBits: AfAlt | AfChar ;
        appendItem: '~Install...	Alt+I' selector: #installFile accelKey: $i accelBits: AfAlt | AfChar ;
        appendItem: '~Save	Alt+S' selector: #accept accelKey: $s accelBits: AfAlt | AfChar ;
        appendItem: 'Save ~As...	Alt+A' selector: #saveAs accelKey: $a accelBits: AfAlt | AfChar ;
        appendItem: '~Browse Classes	Alt+B' selector: #openClassBrowser accelKey: $b accelBits: AfAlt | AfChar ;
		appendSeparator;
		appendItem: 'Browse App~lications' selector: #openChApplicationBrowser;
		appendItem: 'Browse ~Changes' selector: #openChangeBrowser;
		appendItem: 'Build ~Libraries' selector: #openLibraryBuilder;
		appendItem: 'Edit IPF Files' selector: #openIPFBrowser;
		appendSeparator;
        appendItem: 'Browse ~Disk	Alt+D' selector: #openDiskBrowser accelKey: $d accelBits: AfAlt | AfChar ;
        appendItem: '~Print	Alt+P' selector: #print accelKey: $p accelBits: AfAlt | AfChar ;
        appendItem: '~Restore	Alt+R' selector: #restore accelKey: $r accelBits: AfAlt | AfChar ;
        appendSeparator ;
        appendItem: 'Save Image...' selector: #saveImage ;
        title: '~File'! !



!TextPane methods !
  
formatComment 
		"Format the comment of the method in the text pane."
		"@06.11.93 ch"    
    | start end |  
	self disableRefresh.
	self selectBefore: 1 @ 1.
    (self searchPM: MlfsearchSelectmatch  for: '"') ifFalse: [^self].
    self getPMSelection. start := selStart.
	(self searchPM: MlfsearchSelectmatch  for: '"') ifFalse: [^self].
	self getPMSelection. end := selEnd.
	self selectFrom: ((self pointFromIndex: start) x: 1) to: 
		(self pointFromIndex: end).
	self insert: (self selectedItem 
		formatLeftString: (String with: Tab with: Tab) width: 50).
	self enableRefresh!

implementorsOfSelection
		"Open a message browser on the implementors of the the selected 
		string. If the selection is empty prompt the user for a string."
		"@06.11.93 ch"  
	| aString | 
	(aString := self selectedItem) isEmpty ifTrue: [
		aString := Prompter prompt: 'Please enter a selector name.'
			default: ''].
	aString isNil ifTrue: [^self].
	aString := aString trim: #isSelectorCharacter.
	Smalltalk implementorsOf: aString asSymbol!
  
sendersOfSelection
		"Open a message browser on the senders of the the selected 
		string. If the selection is empty prompt the user for a string."
		"@08.05.94 ch: use Smalltalk>>extendedSendersOfSelection:" 
		"@06.03.94 ch: look into Pooldictionaries also" 
		"@06.11.93 ch"  
	| aString | 
	(aString := self selectedItem) isEmpty ifTrue: [
		aString := Prompter 
			prompt: 'Please enter a selector or global or pool variable name.'
			default: ''].
	aString isNil ifTrue: [^self].
	Smalltalk extendedSendersOf: aString.! !



!TextPane class methods !

editMenu
        "Answer the Edit menu."
		"@06.11.93 ch"  
    | ctrlBits |
    ctrlBits := AfChar | AfControl.
    ^Menu new
        appendItem: '~Undo	Alt+BckSp' selector: #undo accelKey: VkBackspace accelBits: AfAlt | AfVirtualkey;
        appendItem: 'Cu~t	Shift+Del' selector: #cutSelection accelKey: VkDelete accelBits: AfShift | AfVirtualkey ;
        appendItem: '~Copy	Ctrl+Ins' selector: #copySelection accelKey: VkInsert accelBits: ctrlBits | AfVirtualkey ;
        appendItem: '~Paste	Shift+Ins' selector: #pasteSelection accelKey: VkInsert accelBits: AfShift | AfVirtualkey ;
        appendItem: 'C~lear	Del' selector: #deleteSelection ;
        appendItem: 'Select ~All	Ctrl+A' selector: #selectAll accelKey: $a accelBits: ctrlBits;
        appendItem: 'Print ~Selection	Ctrl+P' selector: #printSelection accelKey: $p accelBits: ctrlBits;
        appendItem: '~Word Wrap	Ctrl+W' selector: #toggleWrap acceleratorString: 'Ctrl+W';
        appendSubMenu: (self bracketsMenu owner: self) ;
		appendItem: '~Format Comment	Ctrl-O' selector: #formatComment accelKey: $o accelBits: ctrlBits;
        appendSeparator ;
        appendItem: '~Find/Replace...	Ctrl+F' selector: #findReplace accelKey: $f accelBits: ctrlBits;
        appendItem: 'Find A~gain	Ctrl+G' selector: #again accelKey: $g accelBits: ctrlBits;
        accelKey: $c accelBits: ctrlBits  for: #copySelection;
        accelKey: $x accelBits: ctrlBits  for: #cutSelection;
        accelKey: $v accelBits: ctrlBits  for: #pasteSelection;
        title: '~Edit'!
 
smalltalkMenu
        "Answer the Smalltalk menu."
		"@06.11.93 ch"
    ^Menu new
        appendItem: '~Show It	Ctrl+S' selector: #printIt accelKey: $s accelBits: AfChar | AfControl ;
        appendItem: '~Do It	Ctrl+D' selector: #doIt accelKey: $d accelBits: AfChar | AfControl ;
        appendItem: '~Inspect It	Ctrl+I' selector: #inspectIt accelKey: $i accelBits: AfChar | AfControl ;
        appendItem: 'File It I~n	Ctrl+N' selector: #fileItIn accelKey: $n accelBits: AfChar | AfControl ;
        appendItem: 'Senders' selector: #sendersOfSelection;
        appendItem: 'Implementors' selector: #implementorsOfSelection;
        title: '~Smalltalk'! !
"Finalization code"
   !

 
Transcript cr; nextPutAll: 'ChapMan Integration installed.'!
