home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / chapm20.zip / fixo301.cls < prev    next >
Text File  |  1995-06-22  |  14KB  |  438 lines
  1. "Initialization code"
  2.  !
  3.  
  4.  
  5.  
  6. !Collection methods !
  7.   
  8. collect: aBlock
  9.         "For each element in the receiver, evaluate aBlock with
  10.          that element as the argument.  Answer a new collection
  11.          containing the results as its elements from the aBlock
  12.          evaluations."
  13.         "@25.02.94 ch: bug fix: use OrderedCollection instead of 
  14.         self species as the class of the new collection."
  15.     | answer |
  16.     answer := OrderedCollection new.
  17.     self do: [ :element |
  18.         answer add: (aBlock value: element)].
  19.     ^answer! !
  20.  
  21.  
  22.  
  23. !Collection class methods ! !
  24.  
  25.  
  26.  
  27. !HelpManager methods !
  28.  
  29. displayHelp: anId
  30.         "Display the help panel identified by anId
  31.         anId can be either an Integer or a String."
  32.         "@09.06.95 ch: O/S 2 bug workarround: help manager 
  33.         can modify the string <anId>. Make a copy of it."
  34.  
  35.     self setHelpLibraryPath.
  36.     anId isNil ifTrue: [ ^self displayExtendedHelp ].
  37.     anId isString ifTrue: [
  38.         ^( PMWindowLibrary 
  39.             sendMsg: helpInstance
  40.             msg: HmDisplayHelp
  41.             mp1Struct: anId copy asParameter
  42.             mp2: HmPanelname ) asExternalLong asBoolean ].
  43.     anId isInteger ifTrue: [
  44.         ^( PMWindowLibrary 
  45.             sendMsg: helpInstance
  46.             msg: HmDisplayHelp
  47.             mp1: anId 
  48.             mp2: HmpaneltypeNumber ) asExternalLong asBoolean ]!
  49.  
  50. pszTutorialName: tutorialName
  51.     phtHelpTable: tableId
  52.     hmodHelpTableModule: tableModule
  53.     helpWindowTitle: title
  54.     pszHelpLibraryName: libraryPath
  55.     applWindow: window
  56.     aboutDlgClass: aboutClass
  57.     extHelp: extPanelId
  58.     keysHelp: keysPanelId
  59.     dialogs: aCollection
  60.         "Private - Set all info for the receiver."
  61.     helpInit  := SelfDefinedStructure named: 'HELPINIT'.
  62.     helpInit
  63.         cb: helpInit contents size;
  64.         pszTutorialName: tutorialName;
  65.         usShowPanelId: false asParameter;
  66.         hmodAccelActionBarModule: NULL;
  67.         idAccelTable: NULL;
  68.         idActionBar: NULL.
  69.     helpTableId := tableId.
  70.     helpTableModule := tableModule.
  71.     helpWindowTitle := title.
  72.     helpLibraryPath := libraryPath.
  73.     applicationWindow := window.
  74.     aboutDlgClass := aboutClass.
  75.     extHelpPanelId := extPanelId.
  76.     keysHelpPanelId := keysPanelId.
  77.  
  78.     "Work around for bug in the 3.0.1 release help file."
  79.     libraryPath fileNameLessPath = 'vhlp3ao.hlp' ifTrue: [
  80.         extHelpPanelId := 9].
  81.  
  82.     dialogs := aCollection isNil ifTrue: [ #() ] ifFalse: [ aCollection ].
  83.     window helpManager: self.! !
  84.  
  85.  
  86.  
  87. !HelpManager class methods ! !
  88.  
  89.  
  90.  
  91. !MenuWindow methods !
  92.  
  93. destroy
  94.         "Private - Destroy the window and release all associated resources."
  95.         "@01.06.95 ch: bug fix: don't destroy the parent window, which could 
  96.         lead to walkbacks and situations where the image cannot be reloaded." 
  97.  
  98.     PMWindowLibrary destroyWindow: self handle.
  99.     handle := WindowHandle nullValue! !
  100.  
  101.  
  102.  
  103. !MenuWindow class methods ! !
  104.  
  105.  
  106.  
  107. !SubPane methods !
  108.  
  109. helpRequest
  110.         "Private - Notify a help event to any window
  111.         which can handle it following the window chain."
  112.         "@30.04.95 ch: bug fix: didn't set the helpContext" 
  113.     self mainWindow helpContext isNil ifTrue: [
  114.         self mainWindow helpContext: ( Association key: self name value: self ) ].
  115.     ( self handlesEvent: #help )
  116.         ifTrue: [ ^self event: #help ].
  117.     ( self hasActionForEvent: #help )
  118.         ifTrue: [ ^self triggerEvent: #help ].
  119.     ^parent helpRequest
  120. ! !
  121.  
  122.  
  123.  
  124. !SubPane class methods ! !
  125.  
  126.  
  127.  
  128. !ListBox methods !
  129.  
  130. button1Down: aPoint
  131.         "Private - Save this event for processing in #notifySelected: and #button1Up:."
  132.     self propertyAt: #saveButton1Down put: true.
  133.     ^super button1Down: aPoint!
  134.  
  135. button1Up: aPoint
  136.         "Private - the left mouse button was released, trigger
  137.         selected notification."
  138.         "24.3.95 ch : bug fix: the emulation of the windows behaviour caused several problems."
  139.     (self propertyAt: #saveButton1Down) notNil ifTrue: [
  140.         self isOkToChange ifTrue: [
  141.             self triggerEvent: #clicked: with: self selectedItem]
  142.         ].
  143.     ^super button1Up: aPoint!
  144.   
  145. clearSelection
  146.         "Make no list items selected"
  147.         "@24.05.95 : use LitNone not #endList and set the #settingSelection 
  148.         property" 
  149.  
  150.     value := nil.
  151.     self isHandleOk ifFalse: [ ^self ].
  152.     self settingSelection: true.
  153.     PMWindowLibrary
  154.         sendMsg: handle
  155.         msg: LmSelectitem
  156.         mp1: LitNone
  157.         mp2: 0.
  158.     self settingSelection: nil.!
  159.  
  160. contents: aCollection
  161.         "Set the receiver's contents to aCollection."
  162.         "26.3.95 ch: bug fix: value must be set to nil."
  163.     list := aCollection.
  164.     value := nil.
  165.     self isHandleOk ifTrue: [
  166.         self disableRedraw;
  167.             deleteAllFromControl;
  168.             insertArray: list;
  169.             updateHorizontalExtent;
  170.             enableRedraw ].
  171.      ^list!
  172.  
  173. forceSelectionOntoDisplay
  174.         "Private - Scroll the receiver to ensure that the selected item is visible."
  175.         "@28.03.95 ch: Creation"
  176.     | topIndex lines |
  177.     value isNil ifTrue: [^self].
  178.     topIndex := self getTopIndex.
  179.     lines := self drawingRectangle height // self itemHeight.
  180.     (value between: topIndex and: topIndex + lines) ifTrue: [^self].
  181.     self setTopIndex: (value - (lines // 2) max: 1)
  182.  
  183.  
  184. !
  185.    
  186. notifySelected: aParameter
  187.         "Private - the host signaled that an item was selected."
  188.         "23.3.95 ch: bug fixes."
  189.     | oldSelection |
  190.     self selectMessageQueued ifTrue: [ ^nil ].   "do nothing if another select message is queued"
  191.     oldSelection := value.
  192.     self isOkToChange
  193.         ifTrue: [
  194.             self getSelection.
  195.             self event: #select.
  196.             self propertyAt: #saveButton1Down put: nil. "To prevent triggering the #clicked: message in #button1Up."
  197.             self triggerEvent: #clicked: with: self selectedItem.
  198.             oldSelection ~= value ifTrue: [self triggerChanged].
  199.             ]
  200.         ifFalse: [
  201.             self propertyAt: #saveButton1Down put: nil. "To prevent triggering the #clicked: message in #button1Up."
  202.             self selection: oldSelection ].    "restore old selection"
  203. !
  204.  
  205. selection
  206.         "Answer the selection as a one based index."
  207.         "24.3.95 bug fix: always answer the stored value, 
  208.         otherwise two consecutive calls to #selection could yield to 
  209.         different values. The stored value is updated in the #notifySelected: method."
  210.     "self isHandleOk ifTrue: [ ^self getSelection ]."
  211.     ^value!
  212.  
  213. selectMessageQueued
  214.         "Private - answer whether a select message event
  215.         is coming in the input event queue."
  216.     CurrentEvents
  217.         detect: [ :msg |
  218.             msg selector = #asyncControlEvent:with:
  219.             and: [ msg receiver == self
  220.             and: [ msg arguments size = 2
  221.             and: [ ( msg arguments at: 1 ) = LnSelect ] ] ] ]
  222.         ifNone: [ ^false ].
  223.     ^true!
  224.    
  225. setInitialContents
  226.         "Private - set the receiver's contents and selection."
  227.         "@13.4.95 bug fix: preserve the value variable."
  228.     | oldValue |
  229.     oldValue := value.
  230.     self contents: list.
  231.     value := oldValue.
  232.     value notNil ifTrue: [ self setSelection ]!
  233.   
  234. setSelection
  235.         "Private - set the selection in the listbox control
  236.         to correspond to value.  Assumes 'handle = NullHandle'
  237.         is false."
  238.         "@24.05.95 : Call #forceSelectionOntoDisplay" 
  239.  
  240.     | index |
  241.     index := ( value isNil or: [ value < 1 or: [ value > list size ] ] )
  242.         ifTrue: [ self class listEnd ]
  243.         ifFalse: [ value - 1 ].
  244.     self settingSelection: true.
  245.     PMWindowLibrary
  246.         sendMsg: handle
  247.         msg: self selectMessage
  248.         mp1: index
  249.         mp2: true asParameter.
  250.     self settingSelection: nil.
  251.     self forceSelectionOntoDisplay!
  252.   
  253. stringForItem: item
  254.         "Private - Answer a string for the given item (which may be
  255.         either a string or some other object which is converted to
  256.         a string using the current printSelector)."
  257.     | printSelector |
  258.     ^( printSelector := self printSelector ) isNil
  259.         ifTrue: [
  260.             item isString
  261.                 ifTrue: [ item ]
  262.                 ifFalse: [ item printString ] ]
  263.         ifFalse: [ item perform: printSelector ]! !
  264.  
  265.  
  266.  
  267. !ListBox class methods ! !
  268.  
  269.  
  270.  
  271. !DropDownList methods !
  272.  
  273. button1Up: aPoint
  274.         "Private - the left mouse button was released, trigger
  275.         selected notification (note: OS/2 by default notifies of
  276.         mouse selection on button 1 down, but for consistency
  277.         with Windows & ListPane, we trigger on button 1 up)."
  278.         "@01.06.95 ch: bug fix: caused superflues 'Do you want to save' message 
  279.         boxes" 
  280.     | | 
  281.     "self notifySelected: nil"
  282.  
  283.     ^super button1Up: aPoint!
  284.  
  285. syncControlEvent: msg with: aParameter
  286.         "Private - Ignore CbnLbselect events if the #settingSelection property is set."
  287.         "@24.05.95 " 
  288.         "@24.3.95 ch: Bug fix: added this method."
  289.  
  290.     (msg = CbnLbselect and: [self settingSelection]) ifTrue: [^nil].
  291.     ^super syncControlEvent: msg with: aParameter! !
  292.  
  293.  
  294.  
  295. !DropDownList class methods ! !
  296.  
  297.  
  298.  
  299. !MultipleSelectListBox methods !
  300.  
  301. clearSelection
  302.         "Unselect any selected items"
  303.         "@12.5.95 ch: bug fix: call getSelection only if handle is ok."
  304.         "@23.3.95 ch: bug fix: don't trigger the changed event 
  305.         to be consistent with ListBox. Added this method."
  306.     | oldSelection |
  307.     self isHandleOk ifTrue: [ value := self getSelection ].
  308.     oldSelection := self selections.
  309.     value := nil.
  310.     self isHandleOk ifFalse: [ ^self ].
  311.     oldSelection do: [ :item |
  312.         self deselectIndexPrivate: item ].
  313.     "self triggerChanged"!
  314.   
  315. deselectIndexPrivate: itemIndex
  316.         "Private - deselect the item at itemIndex."
  317.         "@24.05.95 " 
  318.         "@23.3.95 ch: bug fix: set the #settingSelection property."
  319.  
  320.     | index |
  321.     value isNil ifFalse: [ value remove: itemIndex ifAbsent: [ nil ] ].
  322.     self isHandleOk ifFalse: [ ^self ].
  323.     index := ( itemIndex isNil or: [ itemIndex < 1 or: [ itemIndex > list size ] ] )
  324.         ifTrue: [ self class listEnd ]
  325.         ifFalse: [ itemIndex - 1 ].
  326.     self settingSelection: true.
  327.     PMWindowLibrary
  328.         sendMsg: handle
  329.         msg: LmSelectitem
  330.         mp1: index
  331.         mp2: false asParameter.
  332.     self settingSelection: nil
  333. !
  334.   
  335. forceSelectionOntoDisplay
  336.         "Private - Scroll the receiver to ensure that the selected item is visible."
  337.         "@28.03.95 ch: Creation"
  338.     | topIndex lines |
  339.     (self isHandleOk not or: [value isNil or: [value isEmpty]]) ifTrue: [^self].
  340.     topIndex := self getTopIndex.
  341.     lines := self drawingRectangle height // self itemHeight.
  342.     (value first between: topIndex and: topIndex + lines) ifTrue: [^self].
  343.     self setTopIndex: (value first - (lines // 2) max: 1)
  344.  
  345.  
  346. !
  347.    
  348. selectIndex: itemIndex
  349.         "Select the item at itemIndex. Index starts at 1."
  350.         "@23.04.95 ch: call #setSelection here not in #selectIndexPrivate:" 
  351.         "23.3.95 ch: bug fix: don't trigger the changed event to be 
  352.         compatible with ListBox."
  353.     ((self isIndexValid: itemIndex ) and: [( self valueIndices includes: itemIndex ) not ] ) ifTrue: [
  354.         self 
  355.             selectIndexPrivate: itemIndex;
  356.             setSelection]!
  357.    
  358. selectIndexPrivate: itemIndex
  359.         "Private - Select the item at itemIndex. Index starts at 1."
  360.         "23.4.95 ch: bug fix don't call #setSelection to prevent 
  361.         multiple sends of this message, which my slow down the
  362.         system."
  363.     | index |
  364.     value isNil ifTrue: [ value := OrderedCollection new ].
  365.     ( itemIndex notNil and: [ ( value includes: itemIndex ) not ] )
  366.         ifTrue: [ value add: itemIndex ].
  367.     self isHandleOk ifFalse: [ ^self ].
  368.     "self setSelection"!
  369.    
  370. selection: anObj
  371.         "If anObj is a collection then select items whose indices
  372.          are in anObj.
  373.          If anObj is nil then unselect all items.
  374.          If anObj is Integer then select the item indexed by anObj.
  375.          Otherwise, select anObj in the list."
  376.     anObj isNil ifTrue: [ self deselectAll. ^self ].
  377.     ( anObj isCollection and: [ anObj isString not ] )
  378.         ifTrue: [
  379.             ( anObj isEmpty or: [ anObj first isInteger ] )
  380.                 ifTrue: [ self valueIndices: anObj ]
  381.                 ifFalse: [ self value: anObj ] ]
  382.         ifFalse: [ super selection: anObj ]!
  383.  
  384. selections
  385.         "Answer indices of the items selected."
  386.         "@08.05.95 ch: Don't call #getSelection to prevent inconsistencies" 
  387.         "self isHandleOk ifTrue: [ value := self getSelection ]."
  388.  
  389.     value isNil ifTrue: [ ^OrderedCollection new ].
  390.     ^value!
  391.  
  392. setSelection
  393.         "Private - set the selection in the listbox control
  394.         to correspond to value.  Assumes 'handle = NullHandle'
  395.         is false."
  396.         "@24.05.95 : Use the #settingSelection property and #forceSelectionOntoDisplay" 
  397.  
  398.     | valueCopy |
  399.     valueCopy := value.  "clearSelections sets value to nil"
  400.     self clearSelections.
  401.     valueCopy isNil ifTrue: [ ^self ].
  402.     value := valueCopy.
  403.     self settingSelection: true.
  404.     valueCopy do: [ :index |
  405.         PMWindowLibrary
  406.             sendMsg: handle
  407.             msg: self selectMessage
  408.             mp1: index - 1
  409.             mp2: true asParameter ].
  410.     self settingSelection: nil.
  411.     self forceSelectionOntoDisplay
  412. !
  413.  
  414. valueIndices: aCollectionOfIntegers
  415.         "Set the selection to the items at the index positions
  416.         in aCollectionOfIntegers."
  417.     | validIndices |
  418.     aCollectionOfIntegers size = 0
  419.         ifTrue: [ ^self clearSelection ].
  420.     validIndices := aCollectionOfIntegers
  421.         select: [ :i | self isIndexValid: i ].
  422.     validIndices isEmpty
  423.         ifTrue: [ ^self clearSelection ].
  424.     value := OrderedCollection new.
  425.     validIndices do: [ :index |
  426.         ( index notNil and: [ ( value includes: index ) not ] )
  427.             ifTrue: [ value add: index ] ].
  428.     self isHandleOk ifTrue: [ self setSelection ]! !
  429.  
  430.  
  431.  
  432. !MultipleSelectListBox class methods ! !
  433. "Finalization code"
  434.    !
  435.  
  436.  
  437. Transcript cr; nextPutAll: 'Bug fixes VSO 3.0.1 installed.'!
  438.