--- a/FileSelectionItem.st Wed Oct 22 15:24:48 1997 +0200
+++ b/FileSelectionItem.st Wed Oct 22 15:26:06 1997 +0200
@@ -13,7 +13,8 @@
TreeItem subclass:#FileSelectionItem
- instanceVariableNames:'matchAction isDirectory imageType invalidate'
+ instanceVariableNames:'modificationTime matchAction isDirectory imageType
+ haveToReadChildren showIndicator'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -57,16 +58,11 @@
icons and filter. Redefinging the icons you have to look especially for
this methods:
- class method: iconsOn: : returns a list of icons used
-
- instance method: updateImageType : set default key into icon list
- for the image associated with node
+ class method: iconsOn: : returns a list of icons used
- imageUnselected : image or key into icon list
- used for unselected mode
+ instance method: imageType : get type of icon assigned to file
- imageSelected : image or key into icon directory
- used for selected mode
+ drawableImageType : get the type of image to be drawn
Especially suited for use with FileSelectionTree.
@@ -141,9 +137,11 @@
) do:[:el |
image := Image fromFile:('xpmBitmaps/document_images/', el last ).
- image notNil ifTrue:[
- icons at:(el first) put:(image onDevice:aDevice).
- ]
+ image notNil ifTrue:[
+ image := image onDevice:aDevice.
+ image clearMaskedPixels.
+ icons at:(el first) put:image.
+ ]
].
^ icons
@@ -155,17 +153,50 @@
children
"get's list of children
"
- invalidate ifTrue:[
- isDirectory ifTrue:[self updateChildren].
- invalidate := false
+ haveToReadChildren ifTrue:[
+ children := self readInChildren
].
^ children
!
+drawableImageType
+ "returns type of image to be drawn
+ "
+ (children size ~~ 0 and:[hide == false]) ifTrue:[
+ ^ #directoryOpened
+ ].
+ ^ self imageType
+!
+
+match:aOneArgBlock
+
+ aOneArgBlock isNil ifTrue:[
+ self discardFiles ifTrue:[
+ matchAction := [:aFile :isDirectory| isDirectory ]
+ ] ifFalse:[
+ self discardDirectories ifTrue:[
+ matchAction := [:aFile :isDirectory| isDirectory not ]
+ ] ifFalse:[
+ matchAction := [:aFile :isDir| true ]
+ ]
+ ]
+ ] ifFalse:[
+ self discardFiles ifTrue:[
+ matchAction := [:aFile :isDirectory| (isDirectory and:[aOneArgBlock value:aFile]) ]
+ ] ifFalse:[
+ self discardDirectories ifTrue:[
+ matchAction := [:aFile :isDirectory| (isDirectory not and:[aOneArgBlock value:aFile]) ]
+ ] ifFalse:[
+ matchAction := [:aFile :isDir| aOneArgBlock value:aFile ]
+ ]
+ ]
+ ]
+!
+
pathName
"returns full pathname of node
"
- ^ contents asString
+ ^ contents asString
!
@@ -173,59 +204,100 @@
pathName:aPathname
"initialze attributes associated with the full pathname, aPathname
"
- contents := self class asFilename:aPathname.
- name := contents baseName.
- isDirectory := contents isDirectory.
- self updateImageType.
+ |file|
+
+ file := self class asFilename:aPathname.
+ self fileName:file baseName:(file baseName) parent:nil isDirectory:(file isDirectory)
+! !
+
+!FileSelectionItem methodsFor:'accessing hierarchy'!
+
+collapse
+ "chech to release children
+ "
+ hide := true.
- isDirectory ifTrue:[
- invalidate := imageType ~~ #directoryLocked
- ] ifFalse:[
- invalidate := false
+ children size ~~ 0 ifTrue:[
+ children do:[:aChild|
+ aChild releaseCollapsedChildren ifFalse:[
+ ^ self
+ ]
+ ].
+ parent notNil ifTrue:[ "/ not for root
+ haveToReadChildren := true.
+ modificationTime := nil.
+ children := OrderedCollection new.
+ ]
+ ]
+!
+
+collapseAll
+ "release my childrens
+ "
+ hide := true.
+
+ children size ~~ 0 ifTrue:[
+ parent isNil ifTrue:[
+ self allChildrenDo:[:aChild| aChild collapseAll ]
+ ] ifFalse:[
+ haveToReadChildren := true.
+ modificationTime := nil.
+ children := OrderedCollection new.
+ ]
].
! !
-!FileSelectionItem methodsFor:'images'!
+!FileSelectionItem methodsFor:'private'!
-imageSelected
- "returns type or an image set for node in selected mode
+fileName:aFilenname baseName:aBaseName parent:aParent isDirectory:aBool
+ "initialze attributes associated with the full pathname, aPathname
"
- "returns type or an image set for node in selected mode
- "
- (isDirectory and:[imageType ~~ #directoryLocked]) ifTrue:[
- ^ #directoryOpened
- ].
- ^ imageType
+ contents := aFilenname.
+ name := aBaseName.
+ parent := aParent.
+ isDirectory := haveToReadChildren := aBool.
+ isDirectory ifFalse:[
+ showIndicator := false
+ ] ifTrue:[
+ showIndicator := nil
+ ].
+
+ parent notNil ifTrue:[
+ matchAction := parent matchAction "/ same as from parent
+ ] ifFalse:[
+ self match:nil "/ setup matchAction new
+ ]
!
-imageUnselected
- "returns type or an image set for node in selected mode
+matchAction
+ "returns my match action
"
- ^ imageType
-
-
-! !
-
-!FileSelectionItem methodsFor:'initialization'!
-
-initialize
- "set default values
- "
- super initialize.
-
- matchAction := nil.
- invalidate := false.
+ ^ matchAction
! !
!FileSelectionItem methodsFor:'queries'!
+discardDirectories
+ "returns true if children are not type of directory; could be
+ reimplemented for speed in any subclass
+ "
+ ^ false
+!
+
+discardFiles
+ "returns true if children are not type of file; could be
+ reimplemented for speed in any subclass
+ "
+ ^ false
+!
+
hasChildren
"returns true if the pathname assigned to this node is a directory
otherwise false
"
- ^ isDirectory
+ ^ isDirectory
!
@@ -233,70 +305,155 @@
^ isDirectory
!
-match:aFilename
- "returns true if file matched otherwise false
+releaseCollapsedChildren
+ "release collapsed children
+ "
+ |canCollapse|
+
+ children size == 0 ifTrue:[
+ ^ true
+ ].
+ canCollapse := true.
+
+ children do:[:aChild|
+ aChild releaseCollapsedChildren ifFalse:[
+ canCollapse := false
+ ]
+ ].
+ (canCollapse and:[self isExpandable]) ifTrue:[
+ parent notNil ifTrue:[ "/ not the root directory
+ haveToReadChildren := true.
+ modificationTime := nil.
+ children := OrderedCollection new.
+ ^ true.
+ ]
+ ].
+ ^ false
+!
+
+showIndicator
+
+ showIndicator isNil ifTrue:[
+ (self imageType == #directoryLocked) ifTrue:[
+ showIndicator := haveToReadChildren := false.
+ ] ifFalse:[
+ showIndicator := DirectoryContents directoryNamed:contents detect:matchAction
+ ]
+ ].
+ ^ showIndicator
+
+! !
+
+!FileSelectionItem methodsFor:'repair mechanism'!
+
+hasObsoleteNodes
+ "check whether node or any child node is obsolete
"
- matchAction notNil ifTrue:[
- ^ matchAction value:aFilename
+ modificationTime notNil ifTrue:[
+ modificationTime < contents modificationTime ifTrue:[
+ ^ true
+ ].
+ (self discardDirectories or:[children size == 0]) ifFalse:[
+ children do:[:aChild| aChild hasObsoleteNodes ifTrue:[^ true]]
+ ]
+ ].
+ ^ false
+!
+
+repairObsoleteNodes
+ "repair nodes
+ "
+ |list chd hasChanged|
+
+ modificationTime isNil ifTrue:[
+ ^ false
].
- ^ true
+
+ modificationTime < contents modificationTime ifTrue:[
+ list := self readInChildren.
+ hasChanged := list size ~~ children size.
+
+ children do:[:aChild||i|
+ i := list findFirst:[:f| f name = aChild name ].
+
+ i ~~ 0 ifTrue:[
+ list at:i put:aChild
+ ] ifFalse:[
+ hasChanged := true
+ ].
+ ].
+ hasChanged ifTrue:[
+ children := list
+ ]
+ ] ifFalse:[
+ hasChanged := false
+ ].
+ children size ~~ 0 ifTrue:[
+ children do:[:aChild|
+ (aChild repairObsoleteNodes) ifTrue:[hasChanged := true]
+ ]
+ ].
+ ^ self shown ifTrue:[hasChanged]
+ ifFalse:[false]
! !
!FileSelectionItem methodsFor:'update'!
-updateChildren
- "read children from directory
- "
- |pathName directory item aFilename|
+imageType
+
+ |readable|
+
+ imageType isNil ifTrue:[
+ readable := contents isReadable.
- children := OrderedCollection new.
- pathName := self pathName.
- directory := pathName asFilename directoryContents.
- directory do:[:aName|
- ((aName first == $.) and:[aName last == $.]) ifFalse:[
- aFilename := contents construct:aName.
- (self match:aFilename) ifTrue:[
- item := self class pathName:aFilename.
- item parent:self.
- children add:item
+ isDirectory ifTrue:[
+ (readable and:[contents isExecutable]) ifTrue:[
+ contents isSymbolicLink ifFalse:[imageType := #directory]
+ ifTrue:[imageType := #directoryLink]
+ ] ifFalse:[
+ imageType := #directoryLocked
+ ]
+ ] ifFalse:[
+ readable ifFalse:[
+ imageType := #fileLocked
+ ] ifTrue:[
+ contents isSymbolicLink ifFalse:[
+ (Image isImageFileSuffix:(contents suffix)) ifFalse:[
+ imageType := #file
+ ] ifTrue:[
+ imageType := #imageFile
+ ]
+ ] ifTrue:[
+ imageType := #fileLink
+ ]
]
]
].
- children sort:[:a :b | a name < b name].
- invalidate := false.
+ ^ imageType
!
-updateImageType
- "update image type
+readInChildren
+ "read children from directory
"
- isDirectory ifTrue:[
- contents isSymbolicLink ifTrue:[
- imageType := #directoryLink
- ] ifFalse:[
- (contents isExecutable and:[contents isReadable]) ifTrue:[
- imageType := #directory
- ] ifFalse:[
- imageType := #directoryLocked
+ |list directory node|
+
+ list := OrderedCollection new.
+
+ self imageType == #directoryLocked ifFalse:[
+ directory := DirectoryContents directoryNamed:contents.
+ 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)
]
- ].
- ^ self
+ ]
].
-
- contents isSymbolicLink ifTrue:[
- imageType := #fileLink
- ] ifFalse:[
- contents isReadable ifTrue:[
- (Image isImageFileSuffix:(contents suffix)) ifFalse:[
- imageType := #file
- ] ifTrue:[
- imageType := #imageFile
- ]
- ] ifFalse:[
- imageType := #fileLocked
- ]
- ]
+ haveToReadChildren := false.
+ showIndicator := list size ~~ 0.
+ ^ list
! !
!FileSelectionItem::Directory class methodsFor:'documentation'!
@@ -315,11 +472,10 @@
! !
-!FileSelectionItem::Directory methodsFor:'initialization'!
+!FileSelectionItem::Directory methodsFor:'queries'!
-initialize
- super initialize.
- matchAction := [:aFilename| aFilename isDirectory ]
+discardFiles
+ ^ true
! !
!FileSelectionItem::File class methodsFor:'documentation'!
@@ -339,11 +495,10 @@
! !
-!FileSelectionItem::File methodsFor:'initialization'!
+!FileSelectionItem::File methodsFor:'queries'!
-initialize
- super initialize.
- matchAction := [:aFilename| aFilename isDirectory not ]
+discardDirectories
+ ^ true
! !
@@ -351,5 +506,5 @@
!FileSelectionItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionItem.st,v 1.5 1997-09-24 04:10:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionItem.st,v 1.6 1997-10-22 13:25:03 ca Exp $'
! !
--- a/FileSelectionTree.st Wed Oct 22 15:24:48 1997 +0200
+++ b/FileSelectionTree.st Wed Oct 22 15:26:06 1997 +0200
@@ -13,7 +13,7 @@
SelectionInTreeView subclass:#FileSelectionTree
- instanceVariableNames:'fileIcons itemClass'
+ instanceVariableNames:'monitoringTask monitoringDelayTime fileIcons itemClass'
classVariableNames:''
poolDictionaries:''
category:'Views-Text'
@@ -276,7 +276,7 @@
listD directory:(Filename homeDirectory).
field editValue:listD directory.
- listD action:[:anIndex||path|
+ listD doubleClickAction:[:anIndex||path|
path := listD selectedPathname.
listF directory:path.
path notNil ifTrue:[field editValue:path]
@@ -288,21 +288,40 @@
!
test
- |top scr|
+ |top scr time total max|
top := StandardSystemView new label:'select'; extent:300@500.
scr := HVScrollableView for:FileSelectionTree origin:(0.0 @ 0.0) corner:(1.0 @ 1.0) in:top.
scr := scr scrolledView.
- scr directory:Filename currentDirectory.
scr selectionHolder:nil asValue.
- scr selectionHolder inspect.
scr multipleSelectOk:true.
+ top openAndWait.
+ total := 0.
- scr action:[:anIndex| Transcript showCR:anIndex.
- Transcript showCR:scr selectedPathname.
- ].
- top open
+ total ~~ 0 ifTrue:[
+ MessageTally spyOn:[
+ scr directory:'/home2/cg/st80src2.5.1'
+ ].
+ ] ifFalse:[
+ max := 20.
+ max timesRepeat:[|time|
+ "/ DirectoryContents releaseResources.
+ time := Time millisecondsToRun:[scr directory:'/home2/cg/st80src2.5.1'].
+ total := total + time.
+ ].
+ Transcript showCR:'----'.
+ Transcript showCR:(total // max).
+ ].
+
+! !
+
+!FileSelectionTree class methodsFor:'constants'!
+
+monitoringDelayTime
+ "default delay time of monitoring task in seconds
+ "
+ ^ 2
! !
!FileSelectionTree methodsFor:'accessing'!
@@ -424,22 +443,68 @@
^ nil
! !
+!FileSelectionTree methodsFor:'accessing monitoring'!
+
+monitoring
+ "returns true if monitor process is running
+ "
+ ^ monitoringTask notNil
+!
+
+monitoring:aState
+ "enable or disable monitoring
+ "
+ aState ifTrue:[
+ monitoringTask isNil ifTrue:[
+ monitoringTask := [ [true] whileTrue:[
+ Delay waitForSeconds:(self monitoringDelayTime).
+ self monitorCycle.
+ ]
+ ] forkAt:8. "/ to block parent task during running
+
+ monitoringTask exitAction:[ monitoringTask := nil ].
+ ]
+ ] ifFalse:[
+ monitoringTask notNil ifTrue:[
+ monitoringTask terminate.
+ monitoringTask := nil.
+ ]
+ ].
+!
+
+monitoringDelayTime
+ "delay time of monitoring task in seconds
+ "
+ ^ monitoringDelayTime
+!
+
+monitoringDelayTime:seconds
+ "delay time of monitoring task in seconds
+ "
+ seconds > 0 ifTrue:[
+ monitoringDelayTime := seconds
+ ]
+! !
+
!FileSelectionTree methodsFor:'drawing basics'!
figureFor:aNode
"get the image used for the node entry.
"
- |keyOrImage|
-
- aNode == self selectedNode ifFalse:[keyOrImage := aNode imageUnselected]
- ifTrue:[keyOrImage := aNode imageSelected].
-
- keyOrImage isSymbol ifTrue:[^ fileIcons at:keyOrImage].
- ^ keyOrImage
+ ^ fileIcons at:(aNode drawableImageType)
! !
!FileSelectionTree methodsFor:'initialization'!
+destroy
+
+ monitoringTask notNil ifTrue:[
+ monitoringTask terminate
+ ].
+ super destroy.
+
+!
+
fetchImageResources
"initialize heavily used device resources - to avoid rendering
images again and again later; returns maximum extent of the images used.
@@ -466,7 +531,7 @@
"
super initialize.
itemClass := FileSelectionItem.
-
+ monitoringDelayTime := self class monitoringDelayTime.
! !
!FileSelectionTree methodsFor:'model'!
@@ -574,10 +639,56 @@
!FileSelectionTree methodsFor:'private'!
+monitorCycle
+ "run monitor cycle
+ "
+ |sz root sel new old|
+
+ (root := model root) isNil ifTrue:[
+ ^ self
+ ].
+
+ root hasObsoleteNodes ifFalse:[
+ ^ self
+ ].
+ (root repairObsoleteNodes) ifFalse:[
+ ^ self
+ ].
+ sz := self numberOfSelections.
+
+ sz ~~ 0 ifTrue:[
+ old := self selection.
+
+ sz == 1 ifTrue:[
+ sel := self selectedNode
+ ] ifFalse:[
+ sel := OrderedCollection new.
+ self selectionDo:[:i| sel add:(listOfNodes at:i) ].
+ ].
+ selection := nil.
+ ].
+ model root:root.
+
+ sz ~~ 0 ifTrue:[
+ selection := old.
+
+ sz == 1 ifTrue:[
+ self selectNode:sel
+ ] ifFalse:[
+ new := OrderedCollection new.
+
+ sel do:[:n||i|
+ (i := self indexOfNode:n) ~~ 0 ifTrue:[new add:i]
+ ].
+ self selection:new
+ ]
+ ]
+!
+
showFile:aPathname
"show a file
"
- |components path root node shown|
+ |components path size root node shown|
path := aPathname asString.
root := self directory.
@@ -587,9 +698,10 @@
self error.
^ shown
].
-
- path size <= (root size + 2) ifTrue:[^ shown].
- path := path copyFrom:(root size + 2).
+ size := root size.
+ path size <= (size + 2) ifTrue:[^ shown].
+ size == 1 ifFalse:[path := path copyFrom:(size + 2)]
+ ifTrue:[path := path copyFrom:2].
components := Filename components:path.
node := model root.
@@ -641,5 +753,5 @@
!FileSelectionTree class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionTree.st,v 1.6 1997-10-11 07:59:16 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionTree.st,v 1.7 1997-10-22 13:26:06 ca Exp $'
! !
--- a/SelTreeV.st Wed Oct 22 15:24:48 1997 +0200
+++ b/SelTreeV.st Wed Oct 22 15:26:06 1997 +0200
@@ -13,10 +13,10 @@
SelectionInListView subclass:#SelectionInTreeView
instanceVariableNames:'validateDoubleClickBlock selectionHolder rootHolder imageWidth
- showLines listOfNodes imageInset textInset openIndicator
- computeResources closeIndicator showRoot extentOpenIndicator
- extentCloseIndicator showDirectoryIndicator indicatorExtentDiv2
- imageOpened imageClosed imageItem'
+ showLines listOfNodes imageInset textInset labelOffsetY
+ openIndicator computeResources closeIndicator showRoot
+ extentOpenIndicator extentCloseIndicator showDirectoryIndicator
+ indicatorExtentDiv2 imageOpened imageClosed imageItem'
classVariableNames:'ImageOpened ImageClosed ImageItem OpenIndicator CloseIndicator'
poolDictionaries:''
category:'Views-Text'
@@ -342,12 +342,6 @@
"Created: 3.7.1997 / 12:34:31 / cg"
!
-imageClosed:anImage
- "set the value of the instance variable 'imageClosed' (automatically generated)"
-
- imageClosed := anImage onDevice:device.
-!
-
imageItem
"return the value of the instance variable 'imageItem' (automatically generated)"
@@ -356,10 +350,18 @@
"Created: 3.7.1997 / 12:34:34 / cg"
!
-imageItem:anImage
- "set the value of the instance variable 'imageItem' (automatically generated)"
+imageOnDevice:anImage
+ "associate iamge to device and clear pixel mask (in case of realized);
+ returns the new image.
+ "
+ |img|
- imageItem := anImage onDevice:device.
+ img := anImage onDevice:device.
+
+ realized ifTrue:[
+ img := img clearMaskedPixels
+ ].
+ ^ img
!
imageOpened
@@ -368,12 +370,6 @@
^ imageOpened
"Created: 3.7.1997 / 12:34:28 / cg"
-!
-
-imageOpened:anImage
- "set the value of the instance variable 'imageOpened' (automatically generated)"
-
- imageOpened := anImage onDevice:device.
! !
!SelectionInTreeView methodsFor:'change & update'!
@@ -438,6 +434,7 @@
index := self visibleLineToAbsoluteLine:startVisLineNr.
size := listOfNodes size.
yTop := self yOfVisibleLine:startVisLineNr.
+ yTop := yTop - 1.
end := endVisLineNr - startVisLineNr + 1.
"/ clear rectangle line and set background color
@@ -469,7 +466,7 @@
self displayLineFromX:x y:yCtr toX:x y:yBot
].
(level ~~ 1 and:[node parent children last == node]) ifTrue:[
- self displayLineFromX:xCross y:yTop toX:xCross y:yCtr . "/ vertical
+ self displayLineFromX:xCross y:yTop - 1 toX:xCross y:yCtr . "/ vertical
].
self displayLineFromX:xCross y:yCtr toX:xFig y:yCtr . "/ horizontal
@@ -480,7 +477,7 @@
(x := (listOfNodes at:idx) level) <= lv ifTrue:[
lv := x - 1.
x := (self xOfFigureLevel:lv) + figWidthDiv2.
- self displayLineFromX:x y:yTop toX:x y:yBot.
+ self displayLineFromX:x y:yTop - 1 toX:x y:yBot.
]
]
].
@@ -495,7 +492,7 @@
self drawLabelIndex:index atX:xStr y:yCtr .
"/ draw directory indicator
- (showDirectoryIndicator and:[node hasChildren]) ifTrue:[
+ (showDirectoryIndicator and:[node showIndicator]) ifTrue:[
node isCollapsable ifTrue:[
image := openIndicator.
x := extentOpenIndicator.
@@ -517,18 +514,18 @@
drawLabelIndex:anIndex atX:x y:yCenter
"draw text label at x and y centered
"
- |y lbl|
-
- lbl := (listOfNodes at:anIndex) name.
+ |lbl|
- lbl notNil ifTrue:[
- y := yCenter - ((lbl heightOn:self) // 2).
+ (lbl := (listOfNodes at:anIndex) name) notNil ifTrue:[
+ self displayOpaqueString:lbl x:x y:(yCenter + labelOffsetY).
+ ]
+!
- (lbl respondsTo:#string) ifTrue:[
- y := y + fontAscent.
- ].
- self displayOpaqueString:lbl x:x y:y.
- ]
+redrawX:x y:y width:w height:h
+
+ self shown ifTrue:[
+ super redrawX:x y:y width:w height:h.
+ ].
! !
!SelectionInTreeView methodsFor:'enumerating'!
@@ -547,6 +544,135 @@
self selectionDo:[:i| aOneArgBlock value:(listOfNodes at:i) ]
! !
+!SelectionInTreeView methodsFor:'event handling'!
+
+buttonMultiPress:button x:x y:y
+
+ (self indicatiorLineForButton:button atX:x y:y) == 0 ifTrue:[
+ ^ super buttonMultiPress:button x:x y:y
+ ].
+ "/ discard doubleClick on indicator
+!
+
+buttonPress:button x:x y:y
+ "check for indicator
+ "
+ |expand node lineNr selNode newSel size oldSelection|
+
+ lineNr := self indicatiorLineForButton:button atX:x y:y.
+
+ lineNr == 0 ifTrue:[
+ ^ super buttonPress:button x:x y:y
+ ].
+ node := listOfNodes at:lineNr.
+
+ ( validateDoubleClickBlock isNil
+ or:[(validateDoubleClickBlock value:node) ~~ false]
+ ) ifFalse:[
+ ^ super buttonPress:button x:x y:y
+ ].
+
+ dragIsActive := false.
+ clickPosition := nil.
+ expand := node isExpandable.
+
+ (size := self numberOfSelections) == 0 ifTrue:[ "/ nothing selected
+ ^ self nodeAt:lineNr expand:expand.
+ ].
+ oldSelection := selection.
+
+ size == 1 ifTrue:[ "/ single selection
+ selNode := self selectedNode.
+
+ lineNr >= self selectedIndex ifTrue:[ "/ operation will not changed
+ ^ self nodeAt:lineNr expand:expand. "/ current selected index
+ ].
+ model setSelectionIndex:0. "/ selected index will change
+ self selectWithoutScroll:nil.
+
+ self nodeAt:lineNr expand:expand.
+ size := self indexOfNode:selNode.
+
+ size == 0 ifTrue:[ "/ old selection no longer visible
+ ^ self selection:lineNr "/ change selection; raise notify
+ ].
+ self selectWithoutScroll:size. "/ can keep old selection
+ model setSelectionIndex:selection. "/ but has to change index
+ ^ self selectionChangedFrom:oldSelection
+ ].
+ selNode := OrderedCollection new:size.
+ newSel := OrderedCollection new:size.
+
+ self selectionDo:[:i|
+ selNode add:(listOfNodes at:i) "/ change selection to nodes
+ ].
+ model setSelectionIndex:0. "/ redraw current selection unselected
+ self selectWithoutScroll:nil.
+ self nodeAt:lineNr expand:expand. "/ perform expand/collapse operation
+
+ selNode do:[:n||i| "/ convert old selection to new selection
+ (i := self indexOfNode:n) ~~ 0 ifTrue:[
+ newSel add:i "/ can take over into new selection
+ ]
+ ].
+
+ newSel isEmpty ifTrue:[ "/ old selection no longer visible
+ ^ self selection:lineNr "/ change selection; raise notify
+ ].
+
+ newSel size == size ifTrue:[
+ self selectWithoutScroll:newSel. "/ can keep old selection
+ model setSelectionIndex:selection. "/ but has to change indeces
+ self selectionChangedFrom:oldSelection.
+ ] ifFalse:[
+ self selection:newSel "/ can keep part of old selection
+ ]
+!
+
+doubleClicked
+ "handle a double click; collapse or expand selected entry
+ in case of having children
+ "
+ |node|
+
+ (node := self selectedNode) notNil ifTrue:[
+ ( validateDoubleClickBlock isNil
+ or:[(validateDoubleClickBlock value:node) ~~ false]
+ ) ifTrue:[
+ self selectedNodeExpand:(node isExpandable).
+ super doubleClicked
+ ]
+ ]
+
+!
+
+indicatiorLineForButton:aButton atX:x y:y
+ "returns linenumber assigned to indicator at x/y or 0
+ "
+ |sensor nr x0 node|
+
+ ( enabled
+ and:[showDirectoryIndicator
+ and:[aButton == 1 or:[aButton == #select]]]
+ ) ifTrue:[
+ sensor := self sensor.
+
+ (sensor ctrlDown or:[sensor shiftDown]) ifFalse:[
+ nr := self visibleLineToListLine:(self visibleLineOfY:y).
+
+ nr notNil ifTrue:[
+ node := listOfNodes at:nr.
+ x0 := self xOfFigureLevel:(node level - 1).
+
+ (x > x0 and:[(x0 + imageWidth) > x and:[node numberOfChildren ~~ 0]]) ifTrue:[
+ ^ nr
+ ]
+ ]
+ ]
+ ].
+ ^ 0
+! !
+
!SelectionInTreeView methodsFor:'initialization'!
destroy
@@ -578,41 +704,19 @@
"
|extent|
- extent := 0@0.
-
imageOpened isNil ifTrue:[
- imageOpened := self class imageOpened.
- imageOpened notNil ifTrue:[
- imageOpened := imageOpened onDevice:device.
- ]
- ].
- imageOpened notNil ifTrue:[
- extent := extent max:(imageOpened extent)
+ imageOpened := (self class imageOpened) onDevice:device
].
imageClosed isNil ifTrue:[
- imageClosed := self class imageClosed.
- imageClosed notNil ifTrue:[
- imageClosed := imageClosed onDevice:device.
- ].
+ imageClosed := self imageOnDevice:(self class imageClosed)
].
- imageClosed notNil ifTrue:[
- extent := extent max:(imageClosed extent)
- ].
+ extent := (imageOpened extent) max:(imageClosed extent).
imageItem isNil ifTrue:[
- imageItem := self class imageItem.
- imageItem notNil ifTrue:[
- imageItem := imageItem onDevice:device.
- ].
+ imageItem := self imageOnDevice:(self class imageItem)
].
- imageItem notNil ifTrue:[
- extent := extent max:(imageItem extent)
- ].
-
- ^ extent
-
- "Modified: 19.9.1997 / 17:14:54 / stefan"
+ ^ extent max:(imageItem extent)
!
getFontParameters
@@ -622,6 +726,7 @@
lineHeight := fontHeight ? 0.
super getFontParameters.
+ labelOffsetY := fontAscent - (fontHeight - lineSpacing // 2).
lineHeight > fontHeight ifTrue:[
fontHeight := lineHeight
@@ -632,6 +737,7 @@
"setup instance attributes
"
super initialize.
+ self bitGravity:#NorthWest.
showLines := true.
showRoot := true.
computeResources := true.
@@ -642,13 +748,19 @@
self model:nil. "/ creates a default model.
!
+realize
+ super realize.
+ self refetchDeviceResources.
+
+!
+
refetchDeviceResources
"reinitialize heavily used device resources - to avoid rendering
images again and again later
"
|extent|
- (computeResources and:[listOfNodes size ~~ 0]) ifTrue:[
+ (realized and:[computeResources and:[listOfNodes size ~~ 0]]) ifTrue:[
computeResources := false.
extent := self fetchImageResources.
@@ -657,6 +769,7 @@
].
imageWidth := extent x.
self recomputeDirectoryIndicator.
+ self computeNumberOfLinesShown.
]
! !
@@ -788,6 +901,34 @@
super list:list keepSelection:keepSelection
!
+nodeAt:anIndex expand:doExpand
+ |node|
+
+ node := listOfNodes at:anIndex.
+
+ node hasChildren ifTrue:[
+ node isExpandable ifTrue:[
+ doExpand ifFalse:[^ self].
+ node expand
+ ] ifFalse:[
+ doExpand ifTrue:[^ self].
+ node collapse
+ ].
+
+ node numberOfChildren == 0 ifTrue:[
+ "/ no children; redraw selected line (image might change)
+ self redrawLine:anIndex.
+ ] ifFalse:[
+ "/ with children; update list and redraw to end.
+ model updateList.
+ list := self listFromModel.
+ self redrawFromLine:anIndex.
+ self contentsChanged.
+ ]
+ ]
+
+!
+
recomputeDirectoryIndicator
"setup attributes used by directory indicator
"
@@ -798,8 +939,12 @@
(showDirectoryIndicator and:[computeResources not]) ifFalse:[
^ self
].
- openIndicator isNil ifTrue:[openIndicator := (self class openIndicator) onDevice:device].
- closeIndicator isNil ifTrue:[closeIndicator := (self class closeIndicator) onDevice:device].
+ openIndicator isNil ifTrue:[
+ openIndicator := self imageOnDevice:(self class openIndicator)
+ ].
+ closeIndicator isNil ifTrue:[
+ closeIndicator := self imageOnDevice:(self class closeIndicator)
+ ].
x1 := (openIndicator widthOn:self) // 2.
y := openIndicator heightOn:self.
@@ -949,23 +1094,6 @@
!SelectionInTreeView methodsFor:'selection'!
-doubleClicked
- "handle a double click; collapse or expand selected entry
- in case of having children
- "
- |node|
-
- (node := self selectedNode) notNil ifTrue:[
- ( validateDoubleClickBlock isNil
- or:[(validateDoubleClickBlock value:node) ~~ false]
- ) ifTrue:[
- self selectedNodeExpand:(node isExpandable).
- super doubleClicked
- ]
- ]
-
-!
-
selectFromListOfNames:aListOfNames
"set selection from a list of names
"
@@ -1177,5 +1305,5 @@
!SelectionInTreeView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelTreeV.st,v 1.27 1997-10-11 12:25:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/Attic/SelTreeV.st,v 1.28 1997-10-22 13:25:22 ca Exp $'
! !
--- a/SelectionInTreeView.st Wed Oct 22 15:24:48 1997 +0200
+++ b/SelectionInTreeView.st Wed Oct 22 15:26:06 1997 +0200
@@ -13,10 +13,10 @@
SelectionInListView subclass:#SelectionInTreeView
instanceVariableNames:'validateDoubleClickBlock selectionHolder rootHolder imageWidth
- showLines listOfNodes imageInset textInset openIndicator
- computeResources closeIndicator showRoot extentOpenIndicator
- extentCloseIndicator showDirectoryIndicator indicatorExtentDiv2
- imageOpened imageClosed imageItem'
+ showLines listOfNodes imageInset textInset labelOffsetY
+ openIndicator computeResources closeIndicator showRoot
+ extentOpenIndicator extentCloseIndicator showDirectoryIndicator
+ indicatorExtentDiv2 imageOpened imageClosed imageItem'
classVariableNames:'ImageOpened ImageClosed ImageItem OpenIndicator CloseIndicator'
poolDictionaries:''
category:'Views-Text'
@@ -342,12 +342,6 @@
"Created: 3.7.1997 / 12:34:31 / cg"
!
-imageClosed:anImage
- "set the value of the instance variable 'imageClosed' (automatically generated)"
-
- imageClosed := anImage onDevice:device.
-!
-
imageItem
"return the value of the instance variable 'imageItem' (automatically generated)"
@@ -356,10 +350,18 @@
"Created: 3.7.1997 / 12:34:34 / cg"
!
-imageItem:anImage
- "set the value of the instance variable 'imageItem' (automatically generated)"
+imageOnDevice:anImage
+ "associate iamge to device and clear pixel mask (in case of realized);
+ returns the new image.
+ "
+ |img|
- imageItem := anImage onDevice:device.
+ img := anImage onDevice:device.
+
+ realized ifTrue:[
+ img := img clearMaskedPixels
+ ].
+ ^ img
!
imageOpened
@@ -368,12 +370,6 @@
^ imageOpened
"Created: 3.7.1997 / 12:34:28 / cg"
-!
-
-imageOpened:anImage
- "set the value of the instance variable 'imageOpened' (automatically generated)"
-
- imageOpened := anImage onDevice:device.
! !
!SelectionInTreeView methodsFor:'change & update'!
@@ -438,6 +434,7 @@
index := self visibleLineToAbsoluteLine:startVisLineNr.
size := listOfNodes size.
yTop := self yOfVisibleLine:startVisLineNr.
+ yTop := yTop - 1.
end := endVisLineNr - startVisLineNr + 1.
"/ clear rectangle line and set background color
@@ -469,7 +466,7 @@
self displayLineFromX:x y:yCtr toX:x y:yBot
].
(level ~~ 1 and:[node parent children last == node]) ifTrue:[
- self displayLineFromX:xCross y:yTop toX:xCross y:yCtr . "/ vertical
+ self displayLineFromX:xCross y:yTop - 1 toX:xCross y:yCtr . "/ vertical
].
self displayLineFromX:xCross y:yCtr toX:xFig y:yCtr . "/ horizontal
@@ -480,7 +477,7 @@
(x := (listOfNodes at:idx) level) <= lv ifTrue:[
lv := x - 1.
x := (self xOfFigureLevel:lv) + figWidthDiv2.
- self displayLineFromX:x y:yTop toX:x y:yBot.
+ self displayLineFromX:x y:yTop - 1 toX:x y:yBot.
]
]
].
@@ -495,7 +492,7 @@
self drawLabelIndex:index atX:xStr y:yCtr .
"/ draw directory indicator
- (showDirectoryIndicator and:[node hasChildren]) ifTrue:[
+ (showDirectoryIndicator and:[node showIndicator]) ifTrue:[
node isCollapsable ifTrue:[
image := openIndicator.
x := extentOpenIndicator.
@@ -517,18 +514,18 @@
drawLabelIndex:anIndex atX:x y:yCenter
"draw text label at x and y centered
"
- |y lbl|
-
- lbl := (listOfNodes at:anIndex) name.
+ |lbl|
- lbl notNil ifTrue:[
- y := yCenter - ((lbl heightOn:self) // 2).
+ (lbl := (listOfNodes at:anIndex) name) notNil ifTrue:[
+ self displayOpaqueString:lbl x:x y:(yCenter + labelOffsetY).
+ ]
+!
- (lbl respondsTo:#string) ifTrue:[
- y := y + fontAscent.
- ].
- self displayOpaqueString:lbl x:x y:y.
- ]
+redrawX:x y:y width:w height:h
+
+ self shown ifTrue:[
+ super redrawX:x y:y width:w height:h.
+ ].
! !
!SelectionInTreeView methodsFor:'enumerating'!
@@ -547,6 +544,135 @@
self selectionDo:[:i| aOneArgBlock value:(listOfNodes at:i) ]
! !
+!SelectionInTreeView methodsFor:'event handling'!
+
+buttonMultiPress:button x:x y:y
+
+ (self indicatiorLineForButton:button atX:x y:y) == 0 ifTrue:[
+ ^ super buttonMultiPress:button x:x y:y
+ ].
+ "/ discard doubleClick on indicator
+!
+
+buttonPress:button x:x y:y
+ "check for indicator
+ "
+ |expand node lineNr selNode newSel size oldSelection|
+
+ lineNr := self indicatiorLineForButton:button atX:x y:y.
+
+ lineNr == 0 ifTrue:[
+ ^ super buttonPress:button x:x y:y
+ ].
+ node := listOfNodes at:lineNr.
+
+ ( validateDoubleClickBlock isNil
+ or:[(validateDoubleClickBlock value:node) ~~ false]
+ ) ifFalse:[
+ ^ super buttonPress:button x:x y:y
+ ].
+
+ dragIsActive := false.
+ clickPosition := nil.
+ expand := node isExpandable.
+
+ (size := self numberOfSelections) == 0 ifTrue:[ "/ nothing selected
+ ^ self nodeAt:lineNr expand:expand.
+ ].
+ oldSelection := selection.
+
+ size == 1 ifTrue:[ "/ single selection
+ selNode := self selectedNode.
+
+ lineNr >= self selectedIndex ifTrue:[ "/ operation will not changed
+ ^ self nodeAt:lineNr expand:expand. "/ current selected index
+ ].
+ model setSelectionIndex:0. "/ selected index will change
+ self selectWithoutScroll:nil.
+
+ self nodeAt:lineNr expand:expand.
+ size := self indexOfNode:selNode.
+
+ size == 0 ifTrue:[ "/ old selection no longer visible
+ ^ self selection:lineNr "/ change selection; raise notify
+ ].
+ self selectWithoutScroll:size. "/ can keep old selection
+ model setSelectionIndex:selection. "/ but has to change index
+ ^ self selectionChangedFrom:oldSelection
+ ].
+ selNode := OrderedCollection new:size.
+ newSel := OrderedCollection new:size.
+
+ self selectionDo:[:i|
+ selNode add:(listOfNodes at:i) "/ change selection to nodes
+ ].
+ model setSelectionIndex:0. "/ redraw current selection unselected
+ self selectWithoutScroll:nil.
+ self nodeAt:lineNr expand:expand. "/ perform expand/collapse operation
+
+ selNode do:[:n||i| "/ convert old selection to new selection
+ (i := self indexOfNode:n) ~~ 0 ifTrue:[
+ newSel add:i "/ can take over into new selection
+ ]
+ ].
+
+ newSel isEmpty ifTrue:[ "/ old selection no longer visible
+ ^ self selection:lineNr "/ change selection; raise notify
+ ].
+
+ newSel size == size ifTrue:[
+ self selectWithoutScroll:newSel. "/ can keep old selection
+ model setSelectionIndex:selection. "/ but has to change indeces
+ self selectionChangedFrom:oldSelection.
+ ] ifFalse:[
+ self selection:newSel "/ can keep part of old selection
+ ]
+!
+
+doubleClicked
+ "handle a double click; collapse or expand selected entry
+ in case of having children
+ "
+ |node|
+
+ (node := self selectedNode) notNil ifTrue:[
+ ( validateDoubleClickBlock isNil
+ or:[(validateDoubleClickBlock value:node) ~~ false]
+ ) ifTrue:[
+ self selectedNodeExpand:(node isExpandable).
+ super doubleClicked
+ ]
+ ]
+
+!
+
+indicatiorLineForButton:aButton atX:x y:y
+ "returns linenumber assigned to indicator at x/y or 0
+ "
+ |sensor nr x0 node|
+
+ ( enabled
+ and:[showDirectoryIndicator
+ and:[aButton == 1 or:[aButton == #select]]]
+ ) ifTrue:[
+ sensor := self sensor.
+
+ (sensor ctrlDown or:[sensor shiftDown]) ifFalse:[
+ nr := self visibleLineToListLine:(self visibleLineOfY:y).
+
+ nr notNil ifTrue:[
+ node := listOfNodes at:nr.
+ x0 := self xOfFigureLevel:(node level - 1).
+
+ (x > x0 and:[(x0 + imageWidth) > x and:[node numberOfChildren ~~ 0]]) ifTrue:[
+ ^ nr
+ ]
+ ]
+ ]
+ ].
+ ^ 0
+! !
+
!SelectionInTreeView methodsFor:'initialization'!
destroy
@@ -578,41 +704,19 @@
"
|extent|
- extent := 0@0.
-
imageOpened isNil ifTrue:[
- imageOpened := self class imageOpened.
- imageOpened notNil ifTrue:[
- imageOpened := imageOpened onDevice:device.
- ]
- ].
- imageOpened notNil ifTrue:[
- extent := extent max:(imageOpened extent)
+ imageOpened := (self class imageOpened) onDevice:device
].
imageClosed isNil ifTrue:[
- imageClosed := self class imageClosed.
- imageClosed notNil ifTrue:[
- imageClosed := imageClosed onDevice:device.
- ].
+ imageClosed := self imageOnDevice:(self class imageClosed)
].
- imageClosed notNil ifTrue:[
- extent := extent max:(imageClosed extent)
- ].
+ extent := (imageOpened extent) max:(imageClosed extent).
imageItem isNil ifTrue:[
- imageItem := self class imageItem.
- imageItem notNil ifTrue:[
- imageItem := imageItem onDevice:device.
- ].
+ imageItem := self imageOnDevice:(self class imageItem)
].
- imageItem notNil ifTrue:[
- extent := extent max:(imageItem extent)
- ].
-
- ^ extent
-
- "Modified: 19.9.1997 / 17:14:54 / stefan"
+ ^ extent max:(imageItem extent)
!
getFontParameters
@@ -622,6 +726,7 @@
lineHeight := fontHeight ? 0.
super getFontParameters.
+ labelOffsetY := fontAscent - (fontHeight - lineSpacing // 2).
lineHeight > fontHeight ifTrue:[
fontHeight := lineHeight
@@ -632,6 +737,7 @@
"setup instance attributes
"
super initialize.
+ self bitGravity:#NorthWest.
showLines := true.
showRoot := true.
computeResources := true.
@@ -642,13 +748,19 @@
self model:nil. "/ creates a default model.
!
+realize
+ super realize.
+ self refetchDeviceResources.
+
+!
+
refetchDeviceResources
"reinitialize heavily used device resources - to avoid rendering
images again and again later
"
|extent|
- (computeResources and:[listOfNodes size ~~ 0]) ifTrue:[
+ (realized and:[computeResources and:[listOfNodes size ~~ 0]]) ifTrue:[
computeResources := false.
extent := self fetchImageResources.
@@ -657,6 +769,7 @@
].
imageWidth := extent x.
self recomputeDirectoryIndicator.
+ self computeNumberOfLinesShown.
]
! !
@@ -788,6 +901,34 @@
super list:list keepSelection:keepSelection
!
+nodeAt:anIndex expand:doExpand
+ |node|
+
+ node := listOfNodes at:anIndex.
+
+ node hasChildren ifTrue:[
+ node isExpandable ifTrue:[
+ doExpand ifFalse:[^ self].
+ node expand
+ ] ifFalse:[
+ doExpand ifTrue:[^ self].
+ node collapse
+ ].
+
+ node numberOfChildren == 0 ifTrue:[
+ "/ no children; redraw selected line (image might change)
+ self redrawLine:anIndex.
+ ] ifFalse:[
+ "/ with children; update list and redraw to end.
+ model updateList.
+ list := self listFromModel.
+ self redrawFromLine:anIndex.
+ self contentsChanged.
+ ]
+ ]
+
+!
+
recomputeDirectoryIndicator
"setup attributes used by directory indicator
"
@@ -798,8 +939,12 @@
(showDirectoryIndicator and:[computeResources not]) ifFalse:[
^ self
].
- openIndicator isNil ifTrue:[openIndicator := (self class openIndicator) onDevice:device].
- closeIndicator isNil ifTrue:[closeIndicator := (self class closeIndicator) onDevice:device].
+ openIndicator isNil ifTrue:[
+ openIndicator := self imageOnDevice:(self class openIndicator)
+ ].
+ closeIndicator isNil ifTrue:[
+ closeIndicator := self imageOnDevice:(self class closeIndicator)
+ ].
x1 := (openIndicator widthOn:self) // 2.
y := openIndicator heightOn:self.
@@ -949,23 +1094,6 @@
!SelectionInTreeView methodsFor:'selection'!
-doubleClicked
- "handle a double click; collapse or expand selected entry
- in case of having children
- "
- |node|
-
- (node := self selectedNode) notNil ifTrue:[
- ( validateDoubleClickBlock isNil
- or:[(validateDoubleClickBlock value:node) ~~ false]
- ) ifTrue:[
- self selectedNodeExpand:(node isExpandable).
- super doubleClicked
- ]
- ]
-
-!
-
selectFromListOfNames:aListOfNames
"set selection from a list of names
"
@@ -1177,5 +1305,5 @@
!SelectionInTreeView class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.27 1997-10-11 12:25:11 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/SelectionInTreeView.st,v 1.28 1997-10-22 13:25:22 ca Exp $'
! !
--- a/TreeItem.st Wed Oct 22 15:24:48 1997 +0200
+++ b/TreeItem.st Wed Oct 22 15:26:06 1997 +0200
@@ -495,6 +495,20 @@
^ (self hasChildren and:[hide == false])
!
+isContainedByParent:aParent
+ "returns true if contained in subtree of a parent
+ "
+ |p|
+
+ p := parent.
+
+ [p notNil] whileTrue:[
+ p == aParent ifTrue:[^ true ].
+ p := p parent
+ ].
+ ^ false
+!
+
isExpandable
"is expandable; children existing and hidden
"
@@ -518,6 +532,10 @@
]
!
+showIndicator
+ ^ self hasChildren
+!
+
shown
^ hide not
! !
@@ -544,5 +562,5 @@
!TreeItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/TreeItem.st,v 1.6 1997-10-10 19:47:32 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/TreeItem.st,v 1.7 1997-10-22 13:25:39 ca Exp $'
! !