--- a/FileSelectionItem.st Wed Feb 25 15:36:47 1998 +0100
+++ b/FileSelectionItem.st Wed Feb 25 15:54:48 1998 +0100
@@ -13,8 +13,7 @@
TreeItem subclass:#FileSelectionItem
- instanceVariableNames:'modificationTime matchAction isDirectory imageType
- haveToReadChildren showIndicator'
+ instanceVariableNames:'modificationTime matchAction isDirectory imageType showIndicator'
classVariableNames:''
poolDictionaries:''
category:'Interface-Support'
@@ -58,11 +57,11 @@
icons and filter. Redefinging the icons you have to look especially for
this methods:
- class method: iconsOn: : returns a list of icons used
+ class method: keysAndIcons : returns a list of icons and access keys used
instance method: imageType : get type of icon assigned to file
- drawableImageType : get the type of image to be drawn
+ icon : get the type of image to be drawn
Especially suited for use with FileSelectionTree.
@@ -114,9 +113,9 @@
^ aPathname asFilename
! !
-!FileSelectionItem class methodsFor:'defaults'!
+!FileSelectionItem class methodsFor:'default icons'!
-iconsOn:aDevice
+keysAndIcons
"returns an IdentityDictionary containing a list of images and keys used
by any file entry.
"
@@ -137,9 +136,8 @@
) do:[:el |
image := Image fromFile:('xpmBitmaps/document_images/', el last ).
+
image notNil ifTrue:[
- image := image onDevice:aDevice.
- image clearMaskedPixels.
icons at:(el first) put:image.
]
].
@@ -153,13 +151,13 @@
children
"get's list of children
"
- haveToReadChildren ifTrue:[
+ readChildren ifTrue:[
children := self readInChildren
].
^ children
!
-drawableImageType
+icon
"returns type of image to be drawn
"
(children size ~~ 0 and:[hide == false]) ifTrue:[
@@ -224,8 +222,8 @@
]
].
parent notNil ifTrue:[ "/ not for root
- haveToReadChildren := true.
- modificationTime := nil.
+ readChildren := true.
+ modificationTime := nil.
children := OrderedCollection new.
]
]
@@ -240,8 +238,8 @@
parent isNil ifTrue:[
self allChildrenDo:[:aChild| aChild collapseAll ]
] ifFalse:[
- haveToReadChildren := true.
- modificationTime := nil.
+ readChildren := true.
+ modificationTime := nil.
children := OrderedCollection new.
]
].
@@ -255,7 +253,7 @@
contents := aFilenname.
name := aBaseName.
parent := aParent.
- isDirectory := haveToReadChildren := aBool.
+ isDirectory := readChildren := aBool.
isDirectory ifFalse:[
showIndicator := false
@@ -322,8 +320,8 @@
].
(canCollapse and:[self isExpandable]) ifTrue:[
parent notNil ifTrue:[ "/ not the root directory
- haveToReadChildren := true.
- modificationTime := nil.
+ readChildren := true.
+ modificationTime := nil.
children := OrderedCollection new.
^ true.
]
@@ -332,10 +330,11 @@
!
showIndicator
-
+ "returns true if the node is a not empty directory
+ "
showIndicator isNil ifTrue:[
(self imageType == #directoryLocked) ifTrue:[
- showIndicator := haveToReadChildren := false.
+ showIndicator := readChildren := false.
] ifFalse:[
showIndicator := DirectoryContents directoryNamed:contents detect:matchAction
]
@@ -451,7 +450,7 @@
]
]
].
- haveToReadChildren := false.
+ readChildren := false.
showIndicator := list size ~~ 0.
^ list
! !
@@ -506,5 +505,5 @@
!FileSelectionItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionItem.st,v 1.7 1998-02-05 15:38:44 ca Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/FileSelectionItem.st,v 1.8 1998-02-25 14:54:48 ca Exp $'
! !
--- a/TreeItem.st Wed Feb 25 15:36:47 1998 +0100
+++ b/TreeItem.st Wed Feb 25 15:54:48 1998 +0100
@@ -14,10 +14,10 @@
Object subclass:#TreeItem
- instanceVariableNames:'name tree parent children contents hide readChildren'
- classVariableNames:''
- poolDictionaries:''
- category:'Interface-Support'
+ instanceVariableNames:'name tree parent children contents hide readChildren'
+ classVariableNames:''
+ poolDictionaries:''
+ category:'Interface-Support'
!
!TreeItem class methodsFor:'documentation'!
@@ -92,6 +92,16 @@
^ self basicNew initialize
! !
+!TreeItem class methodsFor:'default icons'!
+
+keysAndIcons
+ "returns an IdentityDictionary containing a list of images and keys used
+ by any file entry; could be redefined by subclass
+ "
+ ^ nil
+
+! !
+
!TreeItem class methodsFor:'example - instance creation'!
newAsTreeFromSmalltalkClass:aClass
@@ -147,12 +157,9 @@
children
"get list of children
"
- (readChildren and: [children isEmpty])
- ifTrue:
- [
+ (readChildren and:[children isEmpty]) ifTrue:[
self retrieveChildren
].
-
^children
!
@@ -167,9 +174,7 @@
contents
"get contents
"
- contents isNil
- ifTrue:
- [
+ contents isNil ifTrue:[
self retrieveContents
].
^contents
@@ -184,8 +189,8 @@
firstChild
"returns first child in sequence
"
- self numberOfChildren ~~ 0 ifTrue:[
- ^ self children first
+ self children notEmpty ifTrue:[
+ ^ self children at:1
].
^ nil
@@ -202,7 +207,7 @@
!
icon
- "get icon
+ "get the icon
"
^self retrieveAndEvaluate: #iconAction
@@ -211,7 +216,7 @@
lastChild
"returns last child in sequence
"
- self numberOfChildren ~~ 0 ifTrue:[
+ self children notEmpty ifTrue:[
^ self children last
].
^ nil
@@ -221,16 +226,20 @@
level
"get level
"
- parent notNil ifTrue:[^ parent level + 1].
- ^ 1
+ |p
+ lv "{ Class:SmallInteger }"
+ |
+ lv := 1.
+ p := self.
+
+ [ (p := p parent) notNil ] whileTrue:[ lv := lv + 1 ].
+ ^ lv
!
name
"get name
"
- name isNil
- ifTrue:
- [
+ name isNil ifTrue:[
self retrieveLabel
].
^name
@@ -260,12 +269,6 @@
readChildren:= aBoolean
!
-tree:aSelectionInTree
- "set selection in tree
- "
- tree:= aSelectionInTree
-!
-
value
"get contents
"
@@ -316,6 +319,32 @@
]
! !
+!TreeItem methodsFor:'accessing model'!
+
+model
+ "get my model (an instance of selection in tree) or nil
+ "
+ ^ parent notNil ifTrue:[parent model] ifFalse:[tree]
+!
+
+model:aSelectionInTree
+ "set my model (an instance of selection in tree) or nil
+ "
+ tree:= aSelectionInTree
+!
+
+tree
+ "get my model (an instance of selection in tree) or nil
+ "
+ ^ self model
+!
+
+tree:aSelectionInTree
+ "set my model (an instance of selection in tree) or nil
+ "
+ self model:aSelectionInTree
+! !
+
!TreeItem methodsFor:'adding & removing'!
add:something
@@ -396,29 +425,38 @@
!TreeItem methodsFor:'change & update'!
changed
-
- self changed: #value
+ "node changed; raise notification to model
+ "
+ self changed:#value
!
-changed: what
+changed:what
+ "node changed; raise notification to model
+ "
+ |model|
- |model|
self retrieveAll.
- (model := parent ? tree) isNil ifTrue: [^nil].
- model notNil ifTrue: [model update: what with: nil from: self].
+
+ (model := self model) notNil ifTrue:[
+ model update:#value with:nil from:self
+ ]
!
-update:something with:aParameter from:aModel
+update:something with:aParameter from:anItem
+ "raise change notification to my model
+ "
+ |m|
- |model|
- (model := parent ? tree).
- model update: something with: aParameter from: aModel.
+ (m := self model) notNil ifTrue:[
+ m update:something with:aParameter from:anItem
+ ]
! !
!TreeItem methodsFor:'converting'!
fromLiteralArrayEncoding:aLiteralEncodedArray
-
+ "read my contents from a aLiteralEncodedArray.
+ "
|narg|
( (aLiteralEncodedArray size > 0)
@@ -454,17 +492,20 @@
!
literalArrayEncoding
-
- |array childs size|
+ "return myself encoded as a literal array
+ "
+ |array childs size noChld|
contents isString ifTrue:[size := 2]
ifFalse:[size := 1].
- self numberOfChildren == 0 ifTrue:[
+ noChld := self numberOfChildren.
+
+ noChld == 0 ifTrue:[
array := Array new:size
] ifFalse:[
- array := Array new:(size + 1).
- childs := Array new:(self numberOfChildren).
+ array := Array new:size + 1.
+ childs := Array new:noChld.
array at:(size + 1) put:childs.
self children keysAndValuesDo:[:i :aChild|
@@ -494,6 +535,7 @@
node name:(name copy).
node contents:(contents copy).
node children:(self children collect:[:c| c copy]).
+ node readChildren:readChildren.
^ node
! !
@@ -546,12 +588,14 @@
!TreeItem methodsFor:'queries'!
hasChildren
- "returns true if children exists
+ "returns true if any child exists
"
- ^ self children size ~~ 0
+ ^ self children notEmpty
!
hidden
+ "returns true if node is not visible
+ "
^ hide
!
@@ -583,6 +627,8 @@
!
numberOfChildren
+ "returns number of children
+ "
^ self children size
!
@@ -599,94 +645,120 @@
!
showIndicator
+ "returns true if children exists
+ "
^ self hasChildren
!
shown
+ "returns true if node is visible
+ "
^ hide not
! !
!TreeItem methodsFor:'retrieving'!
childrenAction
+ "get children action block
+ "
+ |m|
- |retriever|
- (retriever := parent ? tree) isNil ifTrue: [^nil].
- ^retriever childrenAction
+ ^ (m := self model) notNil ifTrue:[m childrenAction] ifFalse:[nil]
!
contentsAction
+ "get contents action block
+ "
+ |m|
- |retriever|
- (retriever := parent ? tree) isNil ifTrue: [^nil].
- ^retriever contentsAction
+ ^ (m := self model) notNil ifTrue:[m contentsAction] ifFalse:[nil]
!
iconAction
+ "get icon action block
+ "
+ |m|
- |retriever|
- (retriever := parent ? tree) isNil ifTrue: [^nil].
- ^retriever iconAction
+ ^ (m := self model) notNil ifTrue:[m iconAction] ifFalse:[nil]
!
labelAction
+ "get label action block
+ "
+ |m|
- |retriever|
- (retriever := parent ? tree) isNil ifTrue: [^nil].
- ^retriever labelAction
+ ^ (m := self model) notNil ifTrue:[m labelAction] ifFalse:[nil]
!
retrieveAll
-
+ "retrieve all values from model
+ "
self "retrieveContents;" retrieveLabel; retrieveChildren
-
!
retrieveAndEvaluate: aBlockSymbol
+ "retrieve a specific value from model; if no model exists nil is returned
+ "
+ |arg model numArgs|
- |block value retriever|
- (retriever := parent ? tree) isNil ifTrue: [^nil].
- (block := retriever perform: aBlockSymbol) isBlock
- ifTrue:
- [
- block numArgs == 0 ifTrue: [value := block value].
- block numArgs == 1 ifTrue: [value := block value: self].
- ]
- ifFalse:
- [
- value := block
+ (model := self model) isNil ifTrue:[
+ ^ nil
].
- ^value
+ arg := model perform:aBlockSymbol.
+
+ arg isBlock ifFalse:[
+ ^ arg value
+ ].
+ numArgs := arg numArgs.
+ numArgs == 0 ifTrue:[^ arg value].
+ numArgs == 1 ifTrue:[^ arg value:self].
+ self error:'invalid arguments for value'.
+ ^ nil
!
retrieveChildren
+ "retrieve children from model
+ "
+ |retChildren cls|
- |retrievedChildren|
- (retrievedChildren := self retrieveAndEvaluate: #childrenAction) notNil
- ifTrue:
- [
- retrievedChildren isCollection ifFalse: [retrievedChildren := OrderedCollection with: retrievedChildren].
- self children: (retrievedChildren collect:
+ retChildren := self retrieveAndEvaluate:#childrenAction.
+
+ retChildren notNil ifTrue:[
+ retChildren isCollection ifFalse: [retChildren := OrderedCollection with:retChildren].
+ cls := self class.
+
+ self children: (retChildren collect:
[:obj|
- (obj isKindOf: self class)
- ifTrue: [obj]
- ifFalse: [self class new contents: obj]
+ (obj isKindOf:cls) ifTrue:[obj]
+ ifFalse:[cls new contents:obj]
]).
readChildren := false.
].
- ^children
+ ^ children
!
retrieveContents
+ "retrieve contents value from model;
+ "
+ |cont|
- ^contents := (self retrieveAndEvaluate: #contentsAction) ? contents ? ''
+ (cont := self retrieveAndEvaluate: #contentsAction) isNil ifTrue:[
+ cont := contents ? ''
+ ].
+ ^ contents := cont
!
retrieveLabel
+ "retrieve label from model
+ "
+ |n|
- ^name := (self retrieveAndEvaluate: #labelAction) ? name ? ''
+ (n := self retrieveAndEvaluate:#labelAction) isNil ifTrue:[
+ n := name ? ''
+ ].
+ ^ name := n
! !
!TreeItem methodsFor:'searching'!
@@ -702,14 +774,12 @@
indexOfChild:aChild
"get index of a child or 0
"
- (aChild notNil and:[self hasChildren]) ifTrue:[
- ^ self children findFirst:[:c| c == aChild ]
- ].
- ^ 0
+ ^ aChild notNil ifTrue:[self children identityIndexOf:aChild]
+ ifFalse:[0]
! !
!TreeItem class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libwidg2/TreeItem.st,v 1.14 1998-02-24 18:48:50 tz Exp $'
+ ^ '$Header: /cvs/stx/stx/libwidg2/TreeItem.st,v 1.15 1998-02-25 14:54:28 ca Exp $'
! !