home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 10 Tools / 10-Tools.zip / chapm20.zip / fixo30.cls < prev    next >
Text File  |  1995-06-17  |  12KB  |  366 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. !Directory methods !
  28.    
  29. existingFileNamed: fileName
  30. ifAbsent: exceptionBlock
  31.         "Answer the file named <fileName> contained within the receiver. If the name does not define an existing file within the receiver, answer the result of evaluating the <exceptionBlock>."
  32.         "@04.05.95 ch: bug fix: didn't allow absolute pathNames" 
  33.     | file |
  34.     file := (self asFileSystemPath , fileName) asFile.
  35.     file exists ifFalse: [^exceptionBlock value].
  36.     ^file
  37. ! !
  38.  
  39.  
  40.  
  41. !Directory class methods ! !
  42.  
  43.  
  44.  
  45. !SubPane methods !
  46.  
  47. helpRequest
  48.         "Private - Notify a help event to any window
  49.         which can handle it following the window chain."
  50.         "@30.04.95 ch: bug fix: didn't set the helpContext" 
  51.     self mainWindow helpContext isNil ifTrue: [
  52.         self mainWindow helpContext: ( Association key: self name value: self ) ].
  53.     ( self handlesEvent: #help )
  54.         ifTrue: [ ^self event: #help ].
  55.     ( self hasActionForEvent: #help )
  56.         ifTrue: [ ^self triggerEvent: #help ].
  57.     ^parent helpRequest
  58. ! !
  59.  
  60.  
  61.  
  62. !SubPane class methods ! !
  63.  
  64.  
  65.  
  66. !ListBox methods !
  67.  
  68. button1Down: aPoint
  69.         "Private - Save this event for processing in #notifySelected: and #button1Up:."
  70.     self propertyAt: #saveButton1Down put: true.
  71.     ^super button1Down: aPoint!
  72.  
  73. button1Up: aPoint
  74.         "Private - the left mouse button was released, trigger
  75.         selected notification."
  76.         "24.3.95 ch : bug fix."
  77.     (self propertyAt: #saveButton1Down) notNil ifTrue: [
  78.         self isOkToChange ifTrue: [
  79.             self triggerEvent: #clicked: with: self selectedItem]
  80.         ].
  81.     ^super button1Up: aPoint!
  82.   
  83. clearSelection
  84.         "Make no list items selected"
  85.         "@23.03.95 ch: bug fix."
  86.     value := nil.
  87.     self isHandleOk ifFalse: [ ^self ].
  88.     self propertyAt: #settingSelection put: true.
  89.     PMWindowLibrary
  90.         sendMsg: handle
  91.         msg: LmSelectitem
  92.         mp1: LitNone
  93.         mp2: 0.
  94.     self propertyAt: #settingSelection put: nil.!
  95.    
  96. contents: aCollection
  97.         "Set the receiver's contents to aCollection."
  98.         "26.3.95 ch: bug fix: value must be set to nil."
  99.     list := aCollection.
  100.     value := nil.
  101.     self isHandleOk ifTrue: [
  102.         self disableRedraw;
  103.             deleteAllFromControl;
  104.             insertArray: list;
  105.             updateHorizontalExtent;
  106.             enableRedraw ].
  107.      ^list!
  108.  
  109. forceSelectionOntoDisplay
  110.         "Private - Scroll the receiver to ensure that the selected item is visible."
  111.         "@28.03.95 ch: Creation"
  112.     | topIndex lines |
  113.     value isNil ifTrue: [^self].
  114.     topIndex := self getTopIndex.
  115.     lines := self drawingRectangle height // self itemHeight.
  116.     (value between: topIndex and: topIndex + lines) ifTrue: [^self].
  117.     self setTopIndex: (value - (lines // 2) max: 1)
  118.  
  119.  
  120. !
  121.    
  122. notifySelected: aParameter
  123.         "Private - the host signaled that an item was selected."
  124.         "23.3.95 ch: bug fixes."
  125.     | oldSelection |
  126.     self selectMessageQueued ifTrue: [ ^nil ].   "do nothing if another select message is queued"
  127.     oldSelection := value.
  128.     self isOkToChange
  129.         ifTrue: [
  130.             self getSelection.
  131.             self event: #select.
  132.             self propertyAt: #saveButton1Down put: nil. "To prevent triggering the #clicked: message in #button1Up."
  133.             self triggerEvent: #clicked: with: self selectedItem.
  134.             oldSelection ~= value ifTrue: [self triggerChanged].
  135.             ]
  136.         ifFalse: [
  137.             self propertyAt: #saveButton1Down put: nil. "To prevent triggering the #clicked: message in #button1Up."
  138.             self selection: oldSelection ].    "restore old selection"
  139. !
  140.  
  141. selection
  142.         "Answer the selection as a one based index."
  143.         "24.3.95 bug fix: always answer the stored value, 
  144.         otherwise two consecutive calls to #selection could yield to 
  145.         different values. The stored value is updated in the #notifySelected: method."
  146.     "self isHandleOk ifTrue: [ ^self getSelection ]."
  147.     ^value!
  148.  
  149. selectMessageQueued
  150.         "Private - answer whether a select message event
  151.         is coming in the input event queue."
  152.     CurrentEvents
  153.         detect: [ :msg |
  154.             msg selector = #asyncControlEvent:with:
  155.             and: [ msg receiver == self
  156.             and: [ msg arguments size = 2
  157.             and: [ ( msg arguments at: 1 ) = LnSelect ] ] ] ]
  158.         ifNone: [ ^false ].
  159.     ^true!
  160.    
  161. setInitialContents
  162.         "Private - set the receiver's contents and selection."
  163.         "@13.4.95 bug fix: preserve the value variable."
  164.     | oldValue |
  165.     oldValue := value.
  166.     self contents: list.
  167.     value := oldValue.
  168.     value notNil ifTrue: [ self setSelection ]!
  169.   
  170. setSelection
  171.         "Private - set the selection in the listbox control
  172.         to correspond to value.  Assumes 'handle = NullHandle'
  173.         is false."
  174.         "@24.3.95 ch: Bug fix: use the #settingSelection property."
  175.     | index |
  176.     index := ( value isNil or: [ value < 1 or: [ value > list size ] ] )
  177.         ifTrue: [ self class listEnd ]
  178.         ifFalse: [ value - 1 ].
  179.     self propertyAt: #settingSelection put: true.
  180.     PMWindowLibrary
  181.         sendMsg: handle
  182.         msg: self selectMessage
  183.         mp1: index
  184.         mp2: true asParameter.
  185.     self propertyAt: #settingSelection put: nil.
  186.     self forceSelectionOntoDisplay
  187. !
  188.  
  189. stringForItem: item
  190.         "Private - Answer a string for the given item (which may be
  191.         either a string or some other object which is converted to
  192.         a string using the current printSelector)."
  193.     | printSelector printBlock |
  194.     ^( printSelector := self printSelector ) isNil
  195.         ifTrue: [
  196.             item isString
  197.                 ifTrue: [ item ]
  198.                 ifFalse: [ item printString ] ]
  199.         ifFalse: [ item perform: printSelector ]!
  200.  
  201. syncControlEvent: msg with: aParameter
  202.         "Private - Ignore LnSelect events if the #settingSelection property is set."
  203.         "@23.3.95 ch: bug fix: added this method."
  204.     (msg = LnSelect and: [(self propertyAt: #settingSelection) notNil]) ifTrue: [^nil].
  205.     ^super syncControlEvent: msg with: aParameter! !
  206.  
  207.  
  208.  
  209. !ListBox class methods ! !
  210.  
  211.  
  212.  
  213. !DropDownList methods !
  214.   
  215. syncControlEvent: msg with: aParameter
  216.         "Private - Ignore CbnLbselect events if the #settingSelection property is set."
  217.         "24.3.95 ch: Bug fix: added this method."
  218.     (msg = CbnLbselect and: [(self propertyAt: #settingSelection) notNil]) ifTrue: [^nil].
  219.     ^super syncControlEvent: msg with: aParameter! !
  220.  
  221.  
  222.  
  223. !DropDownList class methods ! !
  224.  
  225.  
  226.  
  227. !MultipleSelectListBox methods !
  228.    
  229. clearSelection
  230.         "Unselect any selected items"
  231.         "@12.5.95 ch: bug fix: call getSelection only if handle is ok."
  232.         "@23.3.95 ch: bug fix: don't trigger the changed event 
  233.         to be consistent with ListBox."
  234.     | oldSelection |
  235.     self isHandleOk ifTrue: [ value := self getSelection ].
  236.     oldSelection := self selections.
  237.     value := nil.
  238.     self isHandleOk ifFalse: [ ^self ].
  239.     oldSelection do: [ :item |
  240.         self deselectIndexPrivate: item ].
  241.     "self triggerChanged"!
  242.  
  243. deselectIndexPrivate: itemIndex
  244.         "Private - deselect the item at itemIndex."
  245.         "@23.3.95 ch: bug fix: use the #settingSelection property."
  246.     | index |
  247.     value isNil ifFalse: [ value remove: itemIndex ifAbsent: [ nil ] ].
  248.     self isHandleOk ifFalse: [ ^self ].
  249.     index := ( itemIndex isNil or: [ itemIndex < 1 or: [ itemIndex > list size ] ] )
  250.         ifTrue: [ self class listEnd ]
  251.         ifFalse: [ itemIndex - 1 ].
  252.     self propertyAt: #settingSelection put: true.
  253.     PMWindowLibrary
  254.         sendMsg: handle
  255.         msg: LmSelectitem
  256.         mp1: index
  257.         mp2: false asParameter.
  258.     self propertyAt: #settingSelection put: nil
  259. !
  260.   
  261. forceSelectionOntoDisplay
  262.         "Private - Scroll the receiver to ensure that the selected item is visible."
  263.         "@28.03.95 ch: Creation"
  264.     | topIndex lines |
  265.     (self isHandleOk not or: [value isNil or: [value isEmpty]]) ifTrue: [^self].
  266.     topIndex := self getTopIndex.
  267.     lines := self drawingRectangle height // self itemHeight.
  268.     (value first between: topIndex and: topIndex + lines) ifTrue: [^self].
  269.     self setTopIndex: (value first - (lines // 2) max: 1)
  270.  
  271.  
  272. !
  273.    
  274. selectIndex: itemIndex
  275.         "Select the item at itemIndex. Index starts at 1."
  276.         "@23.04.95 ch: call #setSelection here not in #selectIndexPrivate:" 
  277.         "23.3.95 ch: bug fix: don't trigger the changed event to be 
  278.         compatible with ListBox."
  279.     ((self isIndexValid: itemIndex ) and: [( self valueIndices includes: itemIndex ) not ] ) ifTrue: [
  280.         self 
  281.             selectIndexPrivate: itemIndex;
  282.             setSelection]!
  283.    
  284. selectIndexPrivate: itemIndex
  285.         "Private - Select the item at itemIndex. Index starts at 1."
  286.         "23.4.95 ch: bug fix don't call #setSelection to prevent 
  287.         multiple sends of this message, which my slow down the
  288.         system."
  289.     | index |
  290.     value isNil ifTrue: [ value := OrderedCollection new ].
  291.     ( itemIndex notNil and: [ ( value includes: itemIndex ) not ] )
  292.         ifTrue: [ value add: itemIndex ].
  293.     self isHandleOk ifFalse: [ ^self ].
  294.     "self setSelection"!
  295.    
  296. selection: anObj
  297.         "If anObj is a collection then select items whose indices
  298.          are in anObj.
  299.          If anObj is nil then unselect all items.
  300.          If anObj is Integer then select the item indexed by anObj.
  301.          Otherwise, select anObj in the list."
  302.     | index |
  303.     ( anObj isCollection and: [ anObj isString not ] )
  304.         ifTrue: [
  305.             self disableRedraw.
  306.             self clearSelection.
  307.             anObj do: [ :o |
  308.                 o isInteger
  309.                     ifTrue: [index := o]
  310.                     ifFalse: [index := self indexOf: o].
  311.                 (self isIndexValid: index) ifTrue: [self selectIndexPrivate: index].
  312.                 ].
  313.             self setSelection.
  314.             self enableRedraw ]
  315.         ifFalse: [ super selection: anObj ]!
  316.   
  317. selections
  318.         "Answer indices of the items selected."
  319.         "@08.05.95 ch: Don't call #getSelection to prevent inconsistencies" 
  320.         "self isHandleOk ifTrue: [ value := self getSelection ]."
  321.  
  322.     value isNil ifTrue: [ ^OrderedCollection new ].
  323.     ^value!
  324.  
  325. setSelection
  326.         "Private - set the selection in the listbox control
  327.         to correspond to value.  Assumes 'handle = NullHandle'
  328.         is false."
  329.         "@23.3.95 ch : bug fix: use the #settingSelection property."
  330.     value isNil ifTrue: [ ^self clearSelections ].
  331.     self propertyAt: #settingSelection put: true.
  332.     value do: [ :index |
  333.         PMWindowLibrary
  334.             sendMsg: handle
  335.             msg: self selectMessage
  336.             mp1: index - 1
  337.             mp2: true asParameter ].
  338.     self propertyAt: #settingSelection put: nil.
  339.     self forceSelectionOntoDisplay.
  340. !
  341.  
  342. valueIndices: aCollectionOfIntegers
  343.         "Set the selection to the items at the index positions
  344.         in aCollectionOfIntegers."
  345.         "@23.04.95 ch: bug fix: call #setSelection here not in 
  346.         #selectIndexPrivate:" 
  347.     | validIndices |
  348.     aCollectionOfIntegers size = 0
  349.         ifTrue: [ ^self clearSelection ].
  350.     validIndices := aCollectionOfIntegers
  351.         select: [ :i | self isIndexValid: i ].
  352.     validIndices isEmpty
  353.         ifTrue: [ ^self clearSelection ].
  354.     self clearSelections.
  355.     validIndices do: [ :i | self selectIndexPrivate: i ].
  356.     self setSelection! !
  357.  
  358.  
  359.  
  360. !MultipleSelectListBox class methods ! !
  361. "Finalization code"
  362.     !
  363.  
  364.  
  365. Transcript cr; nextPutAll: 'Bug Fixes VSO 3.0 installed.'!
  366.