async. reading of directory indicators
--- a/FileSelectionItem.st Mon Mar 09 17:07:25 1998 +0100
+++ b/FileSelectionItem.st Mon Mar 09 17:08:44 1998 +0100
@@ -157,6 +157,15 @@
^ children
!
+fileName
+ "returns the fileName of node
+ "
+ ^ contents
+
+
+
+!
+
icon
"returns type of image to be drawn
"
@@ -211,38 +220,36 @@
!FileSelectionItem methodsFor:'accessing hierarchy'!
collapse
- "chech to release children
+ "check to release children
"
+ self stopIndicatorValidation.
hide := true.
- children size ~~ 0 ifTrue:[
+ children notEmpty ifTrue:[
children do:[:aChild|
- aChild releaseCollapsedChildren ifFalse:[
- ^ self
- ]
+ aChild releaseCollapsedChildren ifFalse:[ ^ self ]
].
- parent notNil ifTrue:[ "/ not for root
- readChildren := true.
- modificationTime := nil.
- children := OrderedCollection new.
+ self canReleaseChildren ifTrue:[
+ self releaseChildren
]
]
+
!
collapseAll
"release my childrens
"
+ self stopIndicatorValidation.
hide := true.
- children size ~~ 0 ifTrue:[
- parent isNil ifTrue:[
- self allChildrenDo:[:aChild| aChild collapseAll ]
+ children notEmpty ifTrue:[
+ self canReleaseChildren ifTrue:[
+ self releaseChildren
] ifFalse:[
- readChildren := true.
- modificationTime := nil.
- children := OrderedCollection new.
+ children do:[:c| c releaseChildren ]
]
].
+
! !
!FileSelectionItem methodsFor:'private'!
@@ -273,10 +280,56 @@
"returns my match action
"
^ matchAction
+!
+
+releaseChildren
+ "release my childrens without tests and deregistration from
+ update task
+ "
+ hide := true.
+ readChildren := true.
+ modificationTime := nil.
+ children := OrderedCollection new.
+
+
+!
+
+stopIndicatorValidation
+ "called to stop indicator validation on each child
+ "
+ |model|
+
+ (hide or:[children isEmpty]) ifFalse:[
+ (model := self model) notNil ifTrue:[
+ children do:[:c| c stopIndicatorValidation:model ].
+ model stopIndicatorValidationFor:children
+ ]
+ ]
+
+
+!
+
+stopIndicatorValidation:aModel
+ "called to stop indicator validation on each child
+ "
+ (hide or:[children isEmpty]) ifFalse:[
+ children do:[:c| c stopIndicatorValidation:aModel ].
+ aModel stopIndicatorValidationFor:children
+ ]
+
+
! !
!FileSelectionItem methodsFor:'queries'!
+canReleaseChildren
+ "returns true if children could be released
+ "
+ ^ (parent notNil and:[parent parent notNil])
+
+
+!
+
discardDirectories
"returns true if children are not type of directory; could be
reimplemented for speed in any subclass
@@ -299,6 +352,13 @@
!
+hasValidIndicator
+ "returns true if indication flag is uptodate
+ "
+ ^ showIndicator notNil
+
+!
+
isDirectory
^ isDirectory
!
@@ -306,9 +366,9 @@
releaseCollapsedChildren
"release collapsed children
"
- |canCollapse|
+ |canCollapse model|
- children size == 0 ifTrue:[
+ children isEmpty ifTrue:[
^ true
].
canCollapse := true.
@@ -318,29 +378,52 @@
canCollapse := false
]
].
+
(canCollapse and:[self isExpandable]) ifTrue:[
- parent notNil ifTrue:[ "/ not the root directory
- readChildren := true.
- modificationTime := nil.
- children := OrderedCollection new.
+ self canReleaseChildren ifTrue:[
+ self releaseChildren.
^ true.
]
].
^ false
+
+!
+
+setShowIndicator:aBool
+ "set indication; raise no change notification
+ "
+ showIndicator := aBool.
!
showIndicator
"returns true if the node is a not empty directory
"
+ |model|
+
showIndicator isNil ifTrue:[
(self imageType == #directoryLocked) ifTrue:[
showIndicator := readChildren := false.
] ifFalse:[
- showIndicator := DirectoryContents directoryNamed:contents detect:matchAction
+ (model := self model) notNil ifTrue:[
+ model startIndicatorValidationFor:self.
+ ].
+ ^ false
]
].
^ showIndicator
+
+!
+
+showIndicator:aBool
+ "indication might change; raise a change notification
+ "
+ self showIndicator ~~ aBool ifTrue:[
+ showIndicator := aBool.
+ self changed:#indication
+ ].
+
+
! !
!FileSelectionItem methodsFor:'repair mechanism'!
@@ -352,11 +435,12 @@
modificationTime < contents modificationTime ifTrue:[
^ true
].
- (self discardDirectories or:[children size == 0]) ifFalse:[
+ (self discardDirectories or:[children isEmpty]) ifFalse:[
children do:[:aChild| aChild hasObsoleteNodes ifTrue:[^ true]]
]
].
^ false
+
!
repairObsoleteNodes
@@ -382,6 +466,7 @@
].
].
hasChanged ifTrue:[
+ self stopIndicatorValidation.
children := list
]
] ifFalse:[
@@ -395,6 +480,7 @@
^ self shown ifTrue:[hasChanged]
ifFalse:[false]
+
! !
!FileSelectionItem methodsFor:'update'!
@@ -439,20 +525,31 @@
|list directory node|
list := OrderedCollection new.
+ readChildren := false.
+ showIndicator := false.
self imageType == #directoryLocked ifFalse:[
- directory := DirectoryContents directoryNamed:contents.
- modificationTime := directory modificationTime.
+ Cursor wait showWhile:[
+ directory := DirectoryContents directoryNamed:contents.
- directory contentsAndBaseNamesDo:[:f :n :d|
- (matchAction value:f value:d) ifTrue:[
- list add:(self class new fileName:f baseName:n parent:self isDirectory:d)
+ directory isNil ifTrue:[
+ self stopIndicatorValidation.
+ self releaseChildren.
+ imageType := #directoryLocked.
+ ] ifFalse:[
+ modificationTime := directory modificationTime.
+
+ directory contentsAndBaseNamesDo:[:f :n :d|
+ (matchAction value:f value:d) ifTrue:[
+ list add:(self class new fileName:f baseName:n parent:self isDirectory:d)
+ ]
+ ].
+ showIndicator := list size ~~ 0.
]
]
].
- readChildren := false.
- showIndicator := list size ~~ 0.
^ list
+
! !
!FileSelectionItem::Directory class methodsFor:'documentation'!
@@ -505,5 +602,5 @@
!FileSelectionItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionItem.st,v 1.8 1998-02-25 14:54:48 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionItem.st,v 1.9 1998-03-09 16:08:11 ca Exp $'
! !
--- a/SelInTree.st Mon Mar 09 17:07:25 1998 +0100
+++ b/SelInTree.st Mon Mar 09 17:08:44 1998 +0100
@@ -14,7 +14,7 @@
Model subclass:#SelectionInTree
instanceVariableNames:'root list selection showRoot contentsAction labelAction
- childrenAction iconAction'
+ childrenAction iconAction indicatorList indicatorTask accessLock'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support-Models'
@@ -55,6 +55,12 @@
"
! !
+!SelectionInTree class methodsFor:'instance creation'!
+
+new
+ ^ super new initialize
+! !
+
!SelectionInTree methodsFor:'accessing'!
list
@@ -75,6 +81,7 @@
root notNil ifTrue: [
root tree: nil
].
+ self stopRunningTasks.
(root := aRoot) notNil ifTrue:[
root parent:nil.
@@ -255,6 +262,8 @@
|invalidate|
self each:something do:[:aNode|
+ self stopIndicatorValidationFor:aNode.
+
aNode parent notNil ifTrue:[
aNode parent remove:aNode.
invalidate := true
@@ -262,6 +271,7 @@
].
invalidate == true ifTrue:[self recomputeList].
^ something
+
!
removeIndex:something
@@ -278,6 +288,7 @@
(SortedCollection withAll:something) reverseDo:[:anIndex|
node := list at:anIndex.
+ self stopIndicatorValidationFor:node.
node parent notNil ifTrue:[
node parent remove:node.
@@ -285,6 +296,7 @@
]
].
invalidate == true ifTrue:[self recomputeList].
+
!
removeSelection
@@ -330,8 +342,12 @@
!SelectionInTree methodsFor:'initialization'!
initialize
+
+ showRoot := true.
+ indicatorList := OrderedCollection new.
+ accessLock := Semaphore forMutualExclusion.
super initialize.
- showRoot := true.
+
! !
!SelectionInTree methodsFor:'private'!
@@ -405,8 +421,78 @@
! !
+!SelectionInTree methodsFor:'update indication task'!
+
+startIndicatorValidationFor:aNode
+ "add a node to list of updating indications
+ "
+ |index|
+
+ accessLock critical:[
+ index := indicatorList identityIndexOf:aNode.
+
+ index ~~ 0 ifTrue:[
+ indicatorList removeIndex:index. "/ reorganize list to be faster
+ ].
+ indicatorList addFirst:aNode.
+
+ indicatorTask isNil ifTrue:[
+ indicatorTask := [
+ [ self taskCycle ] whileTrue:[ Processor yield ]
+ ] forkAt:(Processor activePriority - 1)
+ ]
+ ].
+!
+
+stopIndicatorValidationFor:aNodeOrList
+ "remove a node or list of nodes from list of updating indications
+ "
+ accessLock critical:[
+ aNodeOrList isCollection ifTrue:[
+ aNodeOrList do:[:aNode|
+ indicatorList removeIdentical:aNode ifAbsent:nil
+ ]
+ ] ifFalse:[
+ indicatorList removeIdentical:aNodeOrList ifAbsent:nil
+ ]
+ ]
+
+
+!
+
+stopRunningTasks
+ "stop task
+ "
+ accessLock critical:[ indicatorList removeAll ]
+
+!
+
+taskCycle
+ "run one cycle
+ "
+ |node|
+
+ accessLock critical:[
+ indicatorList isEmpty ifTrue:[ "/ queue is empty; terminate task
+ indicatorTask := nil.
+ ^ false
+ ].
+ node := indicatorList removeFirst. "/ run task on first node
+
+ node hasValidIndicator ifTrue:[ "/ up to date
+ ^ true
+ ].
+ node setShowIndicator:false "/ disable registry
+ ].
+
+ (DirectoryContents directoryNamed:(node fileName) detect:(node matchAction)) ifTrue:[
+ node showIndicator:true
+ ].
+ ^ true
+! !
+
!SelectionInTree class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelInTree.st,v 1.9 1998-02-14 16:15:32 tz Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelInTree.st,v 1.10 1998-03-09 16:08:25 ca Exp $'
! !
--- a/SelTreeV.st Mon Mar 09 17:07:25 1998 +0100
+++ b/SelTreeV.st Mon Mar 09 17:08:44 1998 +0100
@@ -14,11 +14,11 @@
SelectionInListView subclass:#SelectionInTreeView
instanceVariableNames:'validateDoubleClickBlock selectionHolder rootHolder imageWidth
showLines listOfNodes imageInset textInset labelOffsetY lineMask
- lineColor openIndicator computeResources closeIndicator showRoot
- extentOpenIndicator extentCloseIndicator showDirectoryIndicator
- showDirectoryIndicatorForRoot indicatorExtentDiv2 imageOpened
- imageClosed imageItem discardMotionEvents registeredImages'
- classVariableNames:'ImageOpened ImageClosed ImageItem OpenIndicator CloseIndicator'
+ lineColor computeResources showRoot showDirectoryIndicator
+ closeIndicator openIndicator showDirectoryIndicatorForRoot
+ imageOpened imageClosed imageItem discardMotionEvents
+ registeredImages'
+ classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
@@ -123,78 +123,61 @@
! !
-!SelectionInTreeView class methodsFor:'default images'!
+!SelectionInTreeView class methodsFor:'resources'!
closeIndicator
<resource: #fileImage>
- CloseIndicator isNil ifTrue:[
- CloseIndicator := Image fromFile:('xpmBitmaps/plus.xpm').
- ].
- ^ CloseIndicator
-"
-CloseIndicator := nil
-"
+ ^ Icon
+ constantNamed:#plus
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')]
+
- "Modified: / 29.10.1997 / 03:36:00 / cg"
+
+
+
+
!
imageClosed
<resource: #fileImage>
- ImageClosed isNil ifTrue:[
- ImageClosed := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm').
- ].
- ^ ImageClosed
-"
-ImageClosed := nil
-"
+ ^ Icon
+ constantNamed:#directory
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')]
- "Modified: / 29.10.1997 / 03:36:05 / cg"
!
imageItem
<resource: #fileImage>
- ImageItem isNil ifTrue:[
- ImageItem := Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')
+ ^ Icon
+ constantNamed:#plainFile
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')]
- ].
- ^ ImageItem
-"
-ImageItem := nil
-"
+
- "Modified: / 29.10.1997 / 03:36:10 / cg"
+
+
!
imageOpened
<resource: #fileImage>
- ImageOpened isNil ifTrue:[
- ImageOpened := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm').
+ ^ Icon
+ constantNamed:#directoryOpened
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')]
- ].
- ^ ImageOpened
-"
-ImageOpened := nil
-"
-
- "Modified: / 29.10.1997 / 03:36:15 / cg"
!
openIndicator
<resource: #fileImage>
- OpenIndicator isNil ifTrue:[
- OpenIndicator := Image fromFile:('xpmBitmaps/minus.xpm').
- ].
- ^ OpenIndicator
-"
-OpenIndicator := nil
-"
+ ^ Icon
+ constantNamed:#minus
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')]
- "Modified: / 29.10.1997 / 03:36:21 / cg"
+
! !
!SelectionInTreeView methodsFor:'accessing'!
@@ -452,24 +435,31 @@
]
] ifFalse:[
(aModel isKindOf:TreeItem) ifTrue:[
- something == #value ifTrue:[
- idx := self indexOfNode:aModel.
-
- idx ~~ 0 ifTrue:[
- list at:idx put:(aModel name).
- self redrawLine:idx
- ].
+ (something == #size or:[something == #children]) ifTrue:[
+ model recomputeList.
^ self
].
- something == #children ifTrue:[
- ^ model recomputeList
- ]
+
+ (idx := self indexOfNode:aModel) ~~ 0 ifTrue:[
+ something == #value ifTrue:[
+ list at:idx put:(aModel name).
+ self redrawLine:idx.
+ ^ self
+ ].
+
+ something == #indication ifTrue:[
+ self redrawIndicatorLine:idx.
+ ^ self
+ ].
+ ].
+ ^ self
]
].
^ super update:something with:aParameter from:aModel.
+
! !
!SelectionInTreeView methodsFor:'drawing'!
@@ -537,10 +527,54 @@
]
!
+redrawIndicatorLine:aLineNr
+ "redraw the directory indicator for a line
+ "
+ |node ext img visLn
+ x "{ Class:SmallInteger }"
+ y "{ Class:SmallInteger }"
+ lv "{ Class:SmallInteger }"
+ dX "{ Class:SmallInteger }"
+ |
+
+ ( shown
+ and:[showDirectoryIndicator
+ and:[(visLn := self listLineToVisibleLine:aLineNr) notNil]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ node := listOfNodes at:aLineNr.
+
+ ((lv := node level) ~~ 1 or:[showDirectoryIndicatorForRoot]) ifFalse:[
+ ^ self
+ ].
+
+ (x := imageWidth // 2) odd ifTrue:[x := x + 1].
+ x := (self xOfFigureLevel:(lv - 1)) + x.
+
+ "/ draw directory indicator
+
+ img := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
+ ext := img extent // 2.
+ dX := ext x.
+
+ (x + dX > 0 and:[(x := x - dX) < (width - margin)]) ifTrue:[
+ (self isInSelection:aLineNr) ifTrue:[ self paint:hilightFgColor on:hilightBgColor ]
+ ifFalse:[ self paint:fgColor on:bgColor ].
+
+ y := (self yOfVisibleLine:visLn) + (fontHeight // 2) - 1.
+ self displayForm:img x:x y:(y - ext y)
+ ].
+
+
+
+!
+
redrawLinesX:x0 y:y0 toX:x1 start:start stop:stop
"redraw from line to line without clearing the background
"
- |node image isSelected defLineColor rnode ext prnt
+ |node image extent isSelected defLineColor rnode prnt
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
level "{ Class:SmallInteger }"
@@ -608,7 +642,9 @@
"/ vertical line from previous to current form
(xCross >= x0 and:[level ~~ 1]) ifTrue:[
- lv := node parent children last == node ifTrue:[yCtr] ifFalse:[yBot].
+ prnt := node parent children.
+ prnt isEmpty ifTrue:[ ^ self ]. "/ error occured
+ lv := prnt last == node ifTrue:[yCtr] ifFalse:[yBot].
self displayLineFromX:xCross y:yTop - 1 toX:xCross y:lv
].
@@ -655,17 +691,12 @@
(showDirectoryIndicator and:[node showIndicator]) ifTrue:[
(level ~~ 1 or:[showDirectoryIndicatorForRoot]) ifTrue:[
- node isCollapsable ifTrue:[
- image := openIndicator.
- ext := extentOpenIndicator.
- ] ifFalse:[
- image := closeIndicator.
- ext := extentCloseIndicator.
- ].
- x := ext x.
+ image := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
+ extent := image extent // 2.
+ x := extent x.
- (xCross - x < x1 and:[xCross + x > x0]) ifTrue:[
- self displayForm:image x:(xCross - x) y:(yCtr - ext y)
+ (xCross + x > x0 and:[(x := xCross - x) < x1]) ifTrue:[
+ self displayForm:image x:x y:(yCtr - extent y)
]
]
].
@@ -673,6 +704,7 @@
index := index + 1.
yTop := yBot.
]
+
!
redrawSelFrameForYs:aList fromX:x0 toX:x1
@@ -782,11 +814,11 @@
].
node := listOfNodes at:lineNr.
- ( validateDoubleClickBlock isNil
- or:[(validateDoubleClickBlock value:node) ~~ false]
- ) ifFalse:[
- ^ super buttonPress:button x:x y:y
- ].
+"/ ( validateDoubleClickBlock isNil
+"/ or:[(validateDoubleClickBlock value:node) ~~ false]
+"/ ) ifFalse:[
+"/ ^ super buttonPress:button x:x y:y
+"/ ].
discardMotionEvents := true.
dragIsActive := false.
clickPosition := nil.
@@ -880,6 +912,38 @@
self gotoLine:index
!
+keyPress:key x:x y:y
+ "handle keyboard input"
+
+ <resource: #keyboard ( #CursorLeft #CursorRight ) >
+
+ |idx node inc end|
+
+ enabled ifFalse:[
+ ^ self
+ ].
+
+ (key == #CursorLeft or:[key == #CursorRight]) ifTrue:[
+ (idx := self selectedIndex) == 0 ifTrue:[ ^ self ].
+
+ (key == #CursorLeft) ifTrue:[ inc := -1. end := 0 ]
+ ifFalse:[ inc := 1. end := 1 + listOfNodes size ].
+
+ [(idx := idx + inc) ~~ end] whileTrue:[
+ node := listOfNodes at:idx.
+ node isDirectory ifTrue:[
+ ^ self key:key select:idx x:x y:y
+ ]
+ ].
+ ^ self
+ ].
+ ^ super keyPress:key x:x y:y
+
+
+
+
+!
+
redrawX:x y:y width:w height:h
"a region must be redrawn"
@@ -957,15 +1021,14 @@
destroy
"remove dependencies
"
- rootHolder notNil ifTrue:[
- rootHolder removeDependent:self
- ].
- selectionHolder notNil ifTrue:[
- selectionHolder removeDependent:self
+ rootHolder removeDependent:self.
+ selectionHolder removeDependent:self.
+
+ model notNil ifTrue:[
+ model stopRunningTasks
].
super destroy.
-
!
fetchDefaultImages
@@ -1064,6 +1127,34 @@
self refetchDeviceResources.
!
+recomputeDirectoryIndicator
+ "setup attributes used by directory indicator
+ "
+ |x w|
+
+ imageInset := 0.
+
+ (showDirectoryIndicator and:[computeResources not]) ifFalse:[
+ ^ self
+ ].
+ openIndicator isNil ifTrue:[
+ openIndicator := self imageOnDevice:(self class openIndicator)
+ ].
+ closeIndicator isNil ifTrue:[
+ closeIndicator := self imageOnDevice:(self class closeIndicator)
+ ].
+ x := (openIndicator width) max:(closeIndicator width).
+ x := x // 2.
+ w := imageWidth // 2.
+
+ (x := x + self class minImageInset) > w ifTrue:[
+ imageInset := x - w.
+ ].
+
+
+
+!
+
refetchDeviceResources
"reinitialize heavily used device resources - to avoid rendering
images again and again later
@@ -1120,9 +1211,14 @@
"
|model|
+ model notNil ifTrue:[
+ model stopRunningTasks
+ ].
+
model := aModel ? (SelectionInTree new).
model showRoot:showRoot.
super model:model.
+
!
rootFromModel
@@ -1226,60 +1322,88 @@
node := listOfNodes at:anIndex.
- node hasChildren ifTrue:[
- node isExpandable ifTrue:[
- doExpand ifFalse:[^ self].
- node expand
- ] ifFalse:[
- doExpand ifTrue:[^ self].
- node collapse
- ].
+ node hasChildren ifFalse:[ "/ no children exists
+ ^ self
+ ].
+
+ node isExpandable ifTrue:[
+ doExpand ifFalse:[^ self]. "/ already collapsed
+ node expand
+ ] ifFalse:[
+ doExpand ifTrue:[^ self]. "/ already expanded
+ node collapse
+ ].
+
+ node children isEmpty ifTrue:[
+ "/ no children; redraw selected line (image might change)
+ self redrawLine:anIndex.
+ ] ifFalse:[
+ "/ with children; update list and redraw to end.
+ model removeDependent:self.
+ model recomputeList.
+ model addDependent:self.
+ list := self listFromModel.
+ self redrawFromLine:anIndex.
+ self contentsChanged.
+ ]
+
+! !
+
+!SelectionInTreeView methodsFor:'private - drag and drop'!
- node children isEmpty ifTrue:[
- "/ no children; redraw selected line (image might change)
- self redrawLine:anIndex.
- ] ifFalse:[
- "/ with children; update list and redraw to end.
- model removeDependent:self.
- model recomputeList.
- model addDependent:self.
- list := self listFromModel.
- self redrawFromLine:anIndex.
- self contentsChanged.
- ]
- ]
+collectionOfDragObjects
+ "returns collection of dragable objects assigned to selection
+ Here, by default, a collection of text-dragObjects is generated;
+ however, if a dragObjectConverter is defined, that one gets a chance
+ to convert as appropriate."
+
+ |collection converted selection dLbl dObj node|
+
+ selection := self selectionAsCollection.
+
+ collection := selection collect:[:nr|
+ node := listOfNodes at:nr.
+ dObj := self dragObjectForNode:node.
+ dObj theObject:(node contents).
+ dLbl := LabelAndIcon icon:(self figureFor:node) string:(list at:nr).
+ dObj displayObject:dLbl.
+ dObj
+ ].
+
+ dragObjectConverter notNil ifTrue:[
+ converted := OrderedCollection new.
+ collection keysAndValuesDo:[:nr :obj |
+ (dObj := dragObjectConverter value:obj) notNil ifTrue:[
+ dLbl := LabelAndIcon icon:(self figureFor:(listOfNodes at:nr)) string:(list at:nr).
+ converted displayObject:dLbl.
+ converted add:dObj
+ ]
+ ].
+ collection := converted
+ ].
+ ^ collection.
+
+
!
-recomputeDirectoryIndicator
- "setup attributes used by directory indicator
+dragObjectForNode:aNode
+ "returns the dragable object for a node; could be redefined in subclass
"
- |x1 x2 y|
+ ^ DropObject new:aNode.
- imageInset := 0.
+
+!
- (showDirectoryIndicator and:[computeResources not]) ifFalse:[
- ^ self
- ].
- openIndicator isNil ifTrue:[
- openIndicator := self imageOnDevice:(self class openIndicator)
- ].
- closeIndicator isNil ifTrue:[
- closeIndicator := self imageOnDevice:(self class closeIndicator)
- ].
+startDragX:x y:y
+ "start drag
+ "
+ dragIsActive := true.
- x1 := (openIndicator widthOn:self) // 2.
- y := openIndicator heightOn:self.
- extentOpenIndicator := Point x:x1 y:(y // 2).
- x2 := (closeIndicator widthOn:self) // 2.
- y := closeIndicator heightOn:self.
- extentCloseIndicator := Point x:x2 y:(y // 2).
+ DragAndDropManager startDrag:(self collectionOfDragObjects)
+ from:self
+ atEnd:endDragAction
- x2 > x1 ifTrue:[x1 := x2].
-
- (x1 := x1 + self class minImageInset) > (imageWidth // 2) ifTrue:[
- imageInset := x1 - (imageWidth // 2).
- ].
! !
@@ -1607,33 +1731,10 @@
selectedNodeExpand:doExpand
"collapse or expand selected node
"
- |node index|
+ |index|
(index := self selectedIndex) ~~ 0 ifTrue:[
- node := listOfNodes at:index.
-
- node hasChildren ifTrue:[
- node isExpandable ifTrue:[
- doExpand ifFalse:[^ self].
- node expand
- ] ifFalse:[
- doExpand ifTrue:[^ self].
- node collapse
- ].
-
- node children isEmpty ifTrue:[
- "/ no children; redraw selected line (image might change)
- self redrawLine:index.
- ] ifFalse:[
- "/ with children; update list and redraw to end.
- model removeDependent:self.
- model recomputeList.
- model addDependent:self.
- list := self listFromModel.
- self redrawFromLine:index.
- self contentsChanged.
- ]
- ]
+ self nodeAt:index expand:doExpand
].
!
@@ -1649,5 +1750,5 @@
!SelectionInTreeView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelTreeV.st,v 1.49 1998-02-26 07:43:55 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelTreeV.st,v 1.50 1998-03-09 16:08:44 ca Exp $'
! !
--- a/SelectionInTree.st Mon Mar 09 17:07:25 1998 +0100
+++ b/SelectionInTree.st Mon Mar 09 17:08:44 1998 +0100
@@ -14,7 +14,7 @@
Model subclass:#SelectionInTree
instanceVariableNames:'root list selection showRoot contentsAction labelAction
- childrenAction iconAction'
+ childrenAction iconAction indicatorList indicatorTask accessLock'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support-Models'
@@ -55,6 +55,12 @@
"
! !
+!SelectionInTree class methodsFor:'instance creation'!
+
+new
+ ^ super new initialize
+! !
+
!SelectionInTree methodsFor:'accessing'!
list
@@ -75,6 +81,7 @@
root notNil ifTrue: [
root tree: nil
].
+ self stopRunningTasks.
(root := aRoot) notNil ifTrue:[
root parent:nil.
@@ -255,6 +262,8 @@
|invalidate|
self each:something do:[:aNode|
+ self stopIndicatorValidationFor:aNode.
+
aNode parent notNil ifTrue:[
aNode parent remove:aNode.
invalidate := true
@@ -262,6 +271,7 @@
].
invalidate == true ifTrue:[self recomputeList].
^ something
+
!
removeIndex:something
@@ -278,6 +288,7 @@
(SortedCollection withAll:something) reverseDo:[:anIndex|
node := list at:anIndex.
+ self stopIndicatorValidationFor:node.
node parent notNil ifTrue:[
node parent remove:node.
@@ -285,6 +296,7 @@
]
].
invalidate == true ifTrue:[self recomputeList].
+
!
removeSelection
@@ -330,8 +342,12 @@
!SelectionInTree methodsFor:'initialization'!
initialize
+
+ showRoot := true.
+ indicatorList := OrderedCollection new.
+ accessLock := Semaphore forMutualExclusion.
super initialize.
- showRoot := true.
+
! !
!SelectionInTree methodsFor:'private'!
@@ -405,8 +421,78 @@
! !
+!SelectionInTree methodsFor:'update indication task'!
+
+startIndicatorValidationFor:aNode
+ "add a node to list of updating indications
+ "
+ |index|
+
+ accessLock critical:[
+ index := indicatorList identityIndexOf:aNode.
+
+ index ~~ 0 ifTrue:[
+ indicatorList removeIndex:index. "/ reorganize list to be faster
+ ].
+ indicatorList addFirst:aNode.
+
+ indicatorTask isNil ifTrue:[
+ indicatorTask := [
+ [ self taskCycle ] whileTrue:[ Processor yield ]
+ ] forkAt:(Processor activePriority - 1)
+ ]
+ ].
+!
+
+stopIndicatorValidationFor:aNodeOrList
+ "remove a node or list of nodes from list of updating indications
+ "
+ accessLock critical:[
+ aNodeOrList isCollection ifTrue:[
+ aNodeOrList do:[:aNode|
+ indicatorList removeIdentical:aNode ifAbsent:nil
+ ]
+ ] ifFalse:[
+ indicatorList removeIdentical:aNodeOrList ifAbsent:nil
+ ]
+ ]
+
+
+!
+
+stopRunningTasks
+ "stop task
+ "
+ accessLock critical:[ indicatorList removeAll ]
+
+!
+
+taskCycle
+ "run one cycle
+ "
+ |node|
+
+ accessLock critical:[
+ indicatorList isEmpty ifTrue:[ "/ queue is empty; terminate task
+ indicatorTask := nil.
+ ^ false
+ ].
+ node := indicatorList removeFirst. "/ run task on first node
+
+ node hasValidIndicator ifTrue:[ "/ up to date
+ ^ true
+ ].
+ node setShowIndicator:false "/ disable registry
+ ].
+
+ (DirectoryContents directoryNamed:(node fileName) detect:(node matchAction)) ifTrue:[
+ node showIndicator:true
+ ].
+ ^ true
+! !
+
!SelectionInTree class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTree.st,v 1.9 1998-02-14 16:15:32 tz Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTree.st,v 1.10 1998-03-09 16:08:25 ca Exp $'
! !
--- a/SelectionInTreeView.st Mon Mar 09 17:07:25 1998 +0100
+++ b/SelectionInTreeView.st Mon Mar 09 17:08:44 1998 +0100
@@ -14,11 +14,11 @@
SelectionInListView subclass:#SelectionInTreeView
instanceVariableNames:'validateDoubleClickBlock selectionHolder rootHolder imageWidth
showLines listOfNodes imageInset textInset labelOffsetY lineMask
- lineColor openIndicator computeResources closeIndicator showRoot
- extentOpenIndicator extentCloseIndicator showDirectoryIndicator
- showDirectoryIndicatorForRoot indicatorExtentDiv2 imageOpened
- imageClosed imageItem discardMotionEvents registeredImages'
- classVariableNames:'ImageOpened ImageClosed ImageItem OpenIndicator CloseIndicator'
+ lineColor computeResources showRoot showDirectoryIndicator
+ closeIndicator openIndicator showDirectoryIndicatorForRoot
+ imageOpened imageClosed imageItem discardMotionEvents
+ registeredImages'
+ classVariableNames:''
poolDictionaries:''
category:'Views-Text'
!
@@ -123,78 +123,61 @@
! !
-!SelectionInTreeView class methodsFor:'default images'!
+!SelectionInTreeView class methodsFor:'resources'!
closeIndicator
<resource: #fileImage>
- CloseIndicator isNil ifTrue:[
- CloseIndicator := Image fromFile:('xpmBitmaps/plus.xpm').
- ].
- ^ CloseIndicator
-"
-CloseIndicator := nil
-"
+ ^ Icon
+ constantNamed:#plus
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/plus.xpm')]
+
- "Modified: / 29.10.1997 / 03:36:00 / cg"
+
+
+
+
!
imageClosed
<resource: #fileImage>
- ImageClosed isNil ifTrue:[
- ImageClosed := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm').
- ].
- ^ ImageClosed
-"
-ImageClosed := nil
-"
+ ^ Icon
+ constantNamed:#directory
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir.xpm')]
- "Modified: / 29.10.1997 / 03:36:05 / cg"
!
imageItem
<resource: #fileImage>
- ImageItem isNil ifTrue:[
- ImageItem := Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')
+ ^ Icon
+ constantNamed:#plainFile
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_file_plain.xpm')]
- ].
- ^ ImageItem
-"
-ImageItem := nil
-"
+
- "Modified: / 29.10.1997 / 03:36:10 / cg"
+
+
!
imageOpened
<resource: #fileImage>
- ImageOpened isNil ifTrue:[
- ImageOpened := Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm').
+ ^ Icon
+ constantNamed:#directoryOpened
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/document_images/tiny_yellow_dir_open.xpm')]
- ].
- ^ ImageOpened
-"
-ImageOpened := nil
-"
-
- "Modified: / 29.10.1997 / 03:36:15 / cg"
!
openIndicator
<resource: #fileImage>
- OpenIndicator isNil ifTrue:[
- OpenIndicator := Image fromFile:('xpmBitmaps/minus.xpm').
- ].
- ^ OpenIndicator
-"
-OpenIndicator := nil
-"
+ ^ Icon
+ constantNamed:#minus
+ ifAbsentPut:[Image fromFile:('xpmBitmaps/minus.xpm')]
- "Modified: / 29.10.1997 / 03:36:21 / cg"
+
! !
!SelectionInTreeView methodsFor:'accessing'!
@@ -452,24 +435,31 @@
]
] ifFalse:[
(aModel isKindOf:TreeItem) ifTrue:[
- something == #value ifTrue:[
- idx := self indexOfNode:aModel.
-
- idx ~~ 0 ifTrue:[
- list at:idx put:(aModel name).
- self redrawLine:idx
- ].
+ (something == #size or:[something == #children]) ifTrue:[
+ model recomputeList.
^ self
].
- something == #children ifTrue:[
- ^ model recomputeList
- ]
+
+ (idx := self indexOfNode:aModel) ~~ 0 ifTrue:[
+ something == #value ifTrue:[
+ list at:idx put:(aModel name).
+ self redrawLine:idx.
+ ^ self
+ ].
+
+ something == #indication ifTrue:[
+ self redrawIndicatorLine:idx.
+ ^ self
+ ].
+ ].
+ ^ self
]
].
^ super update:something with:aParameter from:aModel.
+
! !
!SelectionInTreeView methodsFor:'drawing'!
@@ -537,10 +527,54 @@
]
!
+redrawIndicatorLine:aLineNr
+ "redraw the directory indicator for a line
+ "
+ |node ext img visLn
+ x "{ Class:SmallInteger }"
+ y "{ Class:SmallInteger }"
+ lv "{ Class:SmallInteger }"
+ dX "{ Class:SmallInteger }"
+ |
+
+ ( shown
+ and:[showDirectoryIndicator
+ and:[(visLn := self listLineToVisibleLine:aLineNr) notNil]]
+ ) ifFalse:[
+ ^ self
+ ].
+
+ node := listOfNodes at:aLineNr.
+
+ ((lv := node level) ~~ 1 or:[showDirectoryIndicatorForRoot]) ifFalse:[
+ ^ self
+ ].
+
+ (x := imageWidth // 2) odd ifTrue:[x := x + 1].
+ x := (self xOfFigureLevel:(lv - 1)) + x.
+
+ "/ draw directory indicator
+
+ img := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
+ ext := img extent // 2.
+ dX := ext x.
+
+ (x + dX > 0 and:[(x := x - dX) < (width - margin)]) ifTrue:[
+ (self isInSelection:aLineNr) ifTrue:[ self paint:hilightFgColor on:hilightBgColor ]
+ ifFalse:[ self paint:fgColor on:bgColor ].
+
+ y := (self yOfVisibleLine:visLn) + (fontHeight // 2) - 1.
+ self displayForm:img x:x y:(y - ext y)
+ ].
+
+
+
+!
+
redrawLinesX:x0 y:y0 toX:x1 start:start stop:stop
"redraw from line to line without clearing the background
"
- |node image isSelected defLineColor rnode ext prnt
+ |node image extent isSelected defLineColor rnode prnt
x "{ Class:SmallInteger }"
y "{ Class:SmallInteger }"
level "{ Class:SmallInteger }"
@@ -608,7 +642,9 @@
"/ vertical line from previous to current form
(xCross >= x0 and:[level ~~ 1]) ifTrue:[
- lv := node parent children last == node ifTrue:[yCtr] ifFalse:[yBot].
+ prnt := node parent children.
+ prnt isEmpty ifTrue:[ ^ self ]. "/ error occured
+ lv := prnt last == node ifTrue:[yCtr] ifFalse:[yBot].
self displayLineFromX:xCross y:yTop - 1 toX:xCross y:lv
].
@@ -655,17 +691,12 @@
(showDirectoryIndicator and:[node showIndicator]) ifTrue:[
(level ~~ 1 or:[showDirectoryIndicatorForRoot]) ifTrue:[
- node isCollapsable ifTrue:[
- image := openIndicator.
- ext := extentOpenIndicator.
- ] ifFalse:[
- image := closeIndicator.
- ext := extentCloseIndicator.
- ].
- x := ext x.
+ image := node isCollapsable ifTrue:[openIndicator] ifFalse:[closeIndicator].
+ extent := image extent // 2.
+ x := extent x.
- (xCross - x < x1 and:[xCross + x > x0]) ifTrue:[
- self displayForm:image x:(xCross - x) y:(yCtr - ext y)
+ (xCross + x > x0 and:[(x := xCross - x) < x1]) ifTrue:[
+ self displayForm:image x:x y:(yCtr - extent y)
]
]
].
@@ -673,6 +704,7 @@
index := index + 1.
yTop := yBot.
]
+
!
redrawSelFrameForYs:aList fromX:x0 toX:x1
@@ -782,11 +814,11 @@
].
node := listOfNodes at:lineNr.
- ( validateDoubleClickBlock isNil
- or:[(validateDoubleClickBlock value:node) ~~ false]
- ) ifFalse:[
- ^ super buttonPress:button x:x y:y
- ].
+"/ ( validateDoubleClickBlock isNil
+"/ or:[(validateDoubleClickBlock value:node) ~~ false]
+"/ ) ifFalse:[
+"/ ^ super buttonPress:button x:x y:y
+"/ ].
discardMotionEvents := true.
dragIsActive := false.
clickPosition := nil.
@@ -880,6 +912,38 @@
self gotoLine:index
!
+keyPress:key x:x y:y
+ "handle keyboard input"
+
+ <resource: #keyboard ( #CursorLeft #CursorRight ) >
+
+ |idx node inc end|
+
+ enabled ifFalse:[
+ ^ self
+ ].
+
+ (key == #CursorLeft or:[key == #CursorRight]) ifTrue:[
+ (idx := self selectedIndex) == 0 ifTrue:[ ^ self ].
+
+ (key == #CursorLeft) ifTrue:[ inc := -1. end := 0 ]
+ ifFalse:[ inc := 1. end := 1 + listOfNodes size ].
+
+ [(idx := idx + inc) ~~ end] whileTrue:[
+ node := listOfNodes at:idx.
+ node isDirectory ifTrue:[
+ ^ self key:key select:idx x:x y:y
+ ]
+ ].
+ ^ self
+ ].
+ ^ super keyPress:key x:x y:y
+
+
+
+
+!
+
redrawX:x y:y width:w height:h
"a region must be redrawn"
@@ -957,15 +1021,14 @@
destroy
"remove dependencies
"
- rootHolder notNil ifTrue:[
- rootHolder removeDependent:self
- ].
- selectionHolder notNil ifTrue:[
- selectionHolder removeDependent:self
+ rootHolder removeDependent:self.
+ selectionHolder removeDependent:self.
+
+ model notNil ifTrue:[
+ model stopRunningTasks
].
super destroy.
-
!
fetchDefaultImages
@@ -1064,6 +1127,34 @@
self refetchDeviceResources.
!
+recomputeDirectoryIndicator
+ "setup attributes used by directory indicator
+ "
+ |x w|
+
+ imageInset := 0.
+
+ (showDirectoryIndicator and:[computeResources not]) ifFalse:[
+ ^ self
+ ].
+ openIndicator isNil ifTrue:[
+ openIndicator := self imageOnDevice:(self class openIndicator)
+ ].
+ closeIndicator isNil ifTrue:[
+ closeIndicator := self imageOnDevice:(self class closeIndicator)
+ ].
+ x := (openIndicator width) max:(closeIndicator width).
+ x := x // 2.
+ w := imageWidth // 2.
+
+ (x := x + self class minImageInset) > w ifTrue:[
+ imageInset := x - w.
+ ].
+
+
+
+!
+
refetchDeviceResources
"reinitialize heavily used device resources - to avoid rendering
images again and again later
@@ -1120,9 +1211,14 @@
"
|model|
+ model notNil ifTrue:[
+ model stopRunningTasks
+ ].
+
model := aModel ? (SelectionInTree new).
model showRoot:showRoot.
super model:model.
+
!
rootFromModel
@@ -1226,60 +1322,88 @@
node := listOfNodes at:anIndex.
- node hasChildren ifTrue:[
- node isExpandable ifTrue:[
- doExpand ifFalse:[^ self].
- node expand
- ] ifFalse:[
- doExpand ifTrue:[^ self].
- node collapse
- ].
+ node hasChildren ifFalse:[ "/ no children exists
+ ^ self
+ ].
+
+ node isExpandable ifTrue:[
+ doExpand ifFalse:[^ self]. "/ already collapsed
+ node expand
+ ] ifFalse:[
+ doExpand ifTrue:[^ self]. "/ already expanded
+ node collapse
+ ].
+
+ node children isEmpty ifTrue:[
+ "/ no children; redraw selected line (image might change)
+ self redrawLine:anIndex.
+ ] ifFalse:[
+ "/ with children; update list and redraw to end.
+ model removeDependent:self.
+ model recomputeList.
+ model addDependent:self.
+ list := self listFromModel.
+ self redrawFromLine:anIndex.
+ self contentsChanged.
+ ]
+
+! !
+
+!SelectionInTreeView methodsFor:'private - drag and drop'!
- node children isEmpty ifTrue:[
- "/ no children; redraw selected line (image might change)
- self redrawLine:anIndex.
- ] ifFalse:[
- "/ with children; update list and redraw to end.
- model removeDependent:self.
- model recomputeList.
- model addDependent:self.
- list := self listFromModel.
- self redrawFromLine:anIndex.
- self contentsChanged.
- ]
- ]
+collectionOfDragObjects
+ "returns collection of dragable objects assigned to selection
+ Here, by default, a collection of text-dragObjects is generated;
+ however, if a dragObjectConverter is defined, that one gets a chance
+ to convert as appropriate."
+
+ |collection converted selection dLbl dObj node|
+
+ selection := self selectionAsCollection.
+
+ collection := selection collect:[:nr|
+ node := listOfNodes at:nr.
+ dObj := self dragObjectForNode:node.
+ dObj theObject:(node contents).
+ dLbl := LabelAndIcon icon:(self figureFor:node) string:(list at:nr).
+ dObj displayObject:dLbl.
+ dObj
+ ].
+
+ dragObjectConverter notNil ifTrue:[
+ converted := OrderedCollection new.
+ collection keysAndValuesDo:[:nr :obj |
+ (dObj := dragObjectConverter value:obj) notNil ifTrue:[
+ dLbl := LabelAndIcon icon:(self figureFor:(listOfNodes at:nr)) string:(list at:nr).
+ converted displayObject:dLbl.
+ converted add:dObj
+ ]
+ ].
+ collection := converted
+ ].
+ ^ collection.
+
+
!
-recomputeDirectoryIndicator
- "setup attributes used by directory indicator
+dragObjectForNode:aNode
+ "returns the dragable object for a node; could be redefined in subclass
"
- |x1 x2 y|
+ ^ DropObject new:aNode.
- imageInset := 0.
+
+!
- (showDirectoryIndicator and:[computeResources not]) ifFalse:[
- ^ self
- ].
- openIndicator isNil ifTrue:[
- openIndicator := self imageOnDevice:(self class openIndicator)
- ].
- closeIndicator isNil ifTrue:[
- closeIndicator := self imageOnDevice:(self class closeIndicator)
- ].
+startDragX:x y:y
+ "start drag
+ "
+ dragIsActive := true.
- x1 := (openIndicator widthOn:self) // 2.
- y := openIndicator heightOn:self.
- extentOpenIndicator := Point x:x1 y:(y // 2).
- x2 := (closeIndicator widthOn:self) // 2.
- y := closeIndicator heightOn:self.
- extentCloseIndicator := Point x:x2 y:(y // 2).
+ DragAndDropManager startDrag:(self collectionOfDragObjects)
+ from:self
+ atEnd:endDragAction
- x2 > x1 ifTrue:[x1 := x2].
-
- (x1 := x1 + self class minImageInset) > (imageWidth // 2) ifTrue:[
- imageInset := x1 - (imageWidth // 2).
- ].
! !
@@ -1607,33 +1731,10 @@
selectedNodeExpand:doExpand
"collapse or expand selected node
"
- |node index|
+ |index|
(index := self selectedIndex) ~~ 0 ifTrue:[
- node := listOfNodes at:index.
-
- node hasChildren ifTrue:[
- node isExpandable ifTrue:[
- doExpand ifFalse:[^ self].
- node expand
- ] ifFalse:[
- doExpand ifTrue:[^ self].
- node collapse
- ].
-
- node children isEmpty ifTrue:[
- "/ no children; redraw selected line (image might change)
- self redrawLine:index.
- ] ifFalse:[
- "/ with children; update list and redraw to end.
- model removeDependent:self.
- model recomputeList.
- model addDependent:self.
- list := self listFromModel.
- self redrawFromLine:index.
- self contentsChanged.
- ]
- ]
+ self nodeAt:index expand:doExpand
].
!
@@ -1649,5 +1750,5 @@
!SelectionInTreeView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.49 1998-02-26 07:43:55 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.50 1998-03-09 16:08:44 ca Exp $'
! !