1612 value := value, '...' |
1744 value := value, '...' |
1613 ] |
1745 ] |
1614 ]. |
1746 ]. |
1615 ! ! |
1747 ! ! |
1616 |
1748 |
1617 !ViewTreeApplication::MenuDesc methodsFor:'queries'! |
1749 !ViewTreeInspectorApplication::MenuDesc methodsFor:'queries'! |
1618 |
1750 |
1619 isSeparator |
1751 isSeparator |
1620 ^ title isNil |
1752 ^ title isNil |
1621 ! |
1753 ! |
1622 |
1754 |
1623 widthOn:aGC |
1755 widthOn:aGC |
1624 title isNil ifTrue:[^ 5]. "/ separator |
1756 title isNil ifTrue:[^ 5]. "/ separator |
1625 ^ title widthOn:aGC |
1757 ^ title widthOn:aGC |
1626 ! ! |
1758 ! ! |
1627 |
1759 |
1628 !ViewTreeApplication class methodsFor:'documentation'! |
1760 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'building'! |
|
1761 |
|
1762 buildViewsFrom:aView |
|
1763 "build the items starting from a source view; |
|
1764 returns the anhor. |
|
1765 " |
|
1766 |item subViews subItems| |
|
1767 |
|
1768 aView isNil ifTrue:[^ nil]. |
|
1769 |
|
1770 item := self forView:aView. |
|
1771 subViews := aView subViews. |
|
1772 |
|
1773 subViews notEmptyOrNil ifTrue:[ |
|
1774 subItems := OrderedCollection new. |
|
1775 subViews do:[:aSubView| |
|
1776 subItems add:(self buildViewsFrom:aSubView). |
|
1777 ]. |
|
1778 item children:subItems. |
|
1779 ]. |
|
1780 ^ item |
|
1781 ! ! |
|
1782 |
|
1783 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'documentation'! |
|
1784 |
|
1785 documentation |
|
1786 " |
|
1787 ViewTreeItems represants a pickable object within a ViewTreeModel. |
|
1788 The class is used to build up the hierarchical tree. |
|
1789 |
|
1790 [Instance variables:] |
|
1791 widget <View> the widget represented by the item |
|
1792 spec <UISpecification> the UISpecification or nil |
|
1793 |
|
1794 [Class variables:] |
|
1795 HandleExtent <Point> keeps the extent of a handle |
|
1796 |
|
1797 |
|
1798 [author:] |
|
1799 Claus Atzkern |
|
1800 |
|
1801 [see also:] |
|
1802 HierarchicalItem |
|
1803 ViewTreeModel |
|
1804 " |
|
1805 ! |
1629 |
1806 |
1630 version |
1807 version |
1631 ^ '$Header$' |
1808 ^ '$Header$' |
1632 ! ! |
1809 ! ! |
1633 |
1810 |
1634 ViewTreeApplication initialize! |
1811 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'initialization'! |
|
1812 |
|
1813 initialize |
|
1814 "set the extent of the Handle |
|
1815 " |
|
1816 HandleExtent := 6@6. |
|
1817 ! ! |
|
1818 |
|
1819 !ViewTreeInspectorApplication::ViewTreeItem class methodsFor:'instance creation'! |
|
1820 |
|
1821 forView:aView |
|
1822 |item| |
|
1823 |
|
1824 item := self basicNew initialize. |
|
1825 item forView:aView. |
|
1826 ^ item |
|
1827 ! |
|
1828 |
|
1829 new |
|
1830 self error:'not allowed'. |
|
1831 ^ nil |
|
1832 ! |
|
1833 |
|
1834 on:aView withSpec:aSpec |
|
1835 |item| |
|
1836 |
|
1837 item := self basicNew initialize. |
|
1838 item on:aView withSpec:aSpec. |
|
1839 ^ item |
|
1840 ! ! |
|
1841 |
|
1842 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing'! |
|
1843 |
|
1844 applicationClass |
|
1845 |appl| |
|
1846 |
|
1847 widget notNil ifTrue:[ |
|
1848 appl := widget application. |
|
1849 appl notNil ifTrue:[^ appl class ]. |
|
1850 ]. |
|
1851 ^ nil |
|
1852 ! |
|
1853 |
|
1854 isDrawnShown |
|
1855 "returns true if the last display operations was done during the widget was shown |
|
1856 " |
|
1857 ^ isDrawnShown |
|
1858 ! |
|
1859 |
|
1860 isDrawnShown:aBoolean |
|
1861 isDrawnShown := aBoolean. |
|
1862 ! |
|
1863 |
|
1864 rootView |
|
1865 "returns the widget assigned to the root or nil |
|
1866 " |
|
1867 ^ parent rootView |
|
1868 ! |
|
1869 |
|
1870 specClass |
|
1871 "returns the spec-class assigned to the item |
|
1872 " |
|
1873 ^ widget specClass |
|
1874 ! |
|
1875 |
|
1876 treeModel |
|
1877 "returns the assigned treeModel, an instance of ViewTreeModel |
|
1878 " |
|
1879 ^ parent treeModel |
|
1880 ! |
|
1881 |
|
1882 widget |
|
1883 "returns the widget assigned to the item |
|
1884 " |
|
1885 ^ widget |
|
1886 ! ! |
|
1887 |
|
1888 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing layout'! |
|
1889 |
|
1890 boundsRelativeToRoot |
|
1891 "returns the bounds relative to the root widget |
|
1892 " |
|
1893 ^ self originRelativeToRoot extent:(widget extent) |
|
1894 ! |
|
1895 |
|
1896 cornerRelativeToRoot |
|
1897 "returns the corner relative to the root widget |
|
1898 " |
|
1899 ^ self originRelativeToRoot + (widget extent) |
|
1900 ! |
|
1901 |
|
1902 extent |
|
1903 "returns the extent of the widget |
|
1904 " |
|
1905 ^ widget extent |
|
1906 ! |
|
1907 |
|
1908 layoutType |
|
1909 "returns the type of layout assigned to the wiget; nil if the |
|
1910 superView cannot resize its sub widgets |
|
1911 " |
|
1912 |layout specClass superView| |
|
1913 |
|
1914 (superView := widget superView) isNil ifTrue:[ |
|
1915 ^ #Extent |
|
1916 ]. |
|
1917 |
|
1918 specClass := superView specClass. |
|
1919 |
|
1920 (specClass notNil and:[specClass isLayoutContainer]) ifTrue:[ |
|
1921 ^ specClass canResizeSubComponents ifTrue:[#Extent] ifFalse:[nil] |
|
1922 ]. |
|
1923 |
|
1924 (layout := widget geometryLayout) isNil ifTrue:[ |
|
1925 ^ #Extent |
|
1926 ]. |
|
1927 |
|
1928 layout isLayout ifTrue:[ |
|
1929 layout isLayoutFrame ifTrue:[ ^ #LayoutFrame ]. |
|
1930 layout isAlignmentOrigin ifTrue:[ ^ #AlignmentOrigin ]. |
|
1931 layout isLayoutOrigin ifTrue:[ ^ #LayoutOrigin ]. |
|
1932 ] ifFalse:[ |
|
1933 layout isRectangle ifTrue:[ ^ #Rectangle ]. |
|
1934 layout isPoint ifTrue:[ ^ #Point ]. |
|
1935 |
|
1936 ]. |
|
1937 Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString. |
|
1938 ^ nil |
|
1939 ! |
|
1940 |
|
1941 originRelativeToRoot |
|
1942 "returns the origin relative to the root widget |
|
1943 " |
|
1944 ^ widget originRelativeTo:(self rootView) |
|
1945 ! ! |
|
1946 |
|
1947 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'accessing optimize'! |
|
1948 |
|
1949 children |
|
1950 "redefined: optimize |
|
1951 " |
|
1952 ^ children |
|
1953 ! |
|
1954 |
|
1955 hasChildren |
|
1956 |subViews list item| |
|
1957 |
|
1958 children size ~~ 0 ifTrue:[ |
|
1959 ^ true |
|
1960 ]. |
|
1961 isExpanded := false. |
|
1962 subViews := widget subViews. |
|
1963 |
|
1964 subViews size == 0 ifTrue:[^ false]. |
|
1965 |
|
1966 list := OrderedCollection new. |
|
1967 |
|
1968 subViews do:[:aSubView| |
|
1969 item := self class buildViewsFrom:aSubView. |
|
1970 item parent:self. |
|
1971 list add:item. |
|
1972 ]. |
|
1973 children := list. |
|
1974 ^ true |
|
1975 ! |
|
1976 |
|
1977 size |
|
1978 "redefined: returns list of children |
|
1979 " |
|
1980 ^ children size |
|
1981 ! ! |
|
1982 |
|
1983 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'displaying'! |
|
1984 |
|
1985 additionalLabelForItem:anItem |
|
1986 "answer an additional item for an Item or nil" |
|
1987 |
|
1988 parent notNil ifTrue:[ |
|
1989 ^ parent additionalLabelForItem:anItem |
|
1990 ]. |
|
1991 ^ nil |
|
1992 ! |
|
1993 |
|
1994 displayIcon:anIcon atX:x y:y on:aGC |
|
1995 |x0 y0 y1 w| |
|
1996 |
|
1997 super displayIcon:anIcon atX:x y:y on:aGC. |
|
1998 |
|
1999 self exists ifFalse:[ |
|
2000 aGC paint:(Color red). |
|
2001 |
|
2002 y0 := y + 1. |
|
2003 y1 := y + anIcon height - 2. |
|
2004 |
|
2005 x0 := x - 1. |
|
2006 w := anIcon width. |
|
2007 |
|
2008 2 timesRepeat:[ |
|
2009 aGC displayLineFromX:x0 y:y0 toX:(x0 + w) y:y1. |
|
2010 aGC displayLineFromX:x0 y:y1 toX:(x0 + w) y:y0. |
|
2011 x0 := x0 + 1. |
|
2012 ]. |
|
2013 ]. |
|
2014 ! |
|
2015 |
|
2016 displayOn:aGC x:x y:y h:h |
|
2017 |labelHeight additionalName label isValidAndShown| |
|
2018 |
|
2019 label := self label. |
|
2020 label isEmptyOrNil ifTrue:[^ self]. |
|
2021 |
|
2022 widget id isNil ifTrue:[ |
|
2023 isDrawnShown := false. |
|
2024 |
|
2025 self exists ifFalse:[ |
|
2026 xOffsetAdditionalName := nil. |
|
2027 ]. |
|
2028 isValidAndShown := false. |
|
2029 ] ifFalse:[ |
|
2030 isValidAndShown := widget shown. |
|
2031 ]. |
|
2032 isValidAndShown ifFalse:[ |
|
2033 label := Text string:label emphasis:#italic |
|
2034 ]. |
|
2035 |
|
2036 labelHeight := self heightOn:aGC. |
|
2037 self displayLabel:label h:labelHeight on:aGC x:x y:y h:h. |
|
2038 |
|
2039 xOffsetAdditionalName notNil ifTrue:[ |
|
2040 additionalName := self additionalLabelForItem:self. |
|
2041 |
|
2042 additionalName notNil ifTrue:[ |
|
2043 self displayLabel:additionalName |
|
2044 h:labelHeight on:aGC |
|
2045 x:(x + xOffsetAdditionalName) |
|
2046 y:y |
|
2047 h:h. |
|
2048 ] ifFalse:[ |
|
2049 xOffsetAdditionalName := nil. |
|
2050 ]. |
|
2051 ]. |
|
2052 ! |
|
2053 |
|
2054 recursiveAdditionalNameBehaviourChanged |
|
2055 width := xOffsetAdditionalName := nil. |
|
2056 |
|
2057 children notNil ifTrue:[ |
|
2058 children do:[:each| each recursiveAdditionalNameBehaviourChanged ] |
|
2059 ]. |
|
2060 ! |
|
2061 |
|
2062 widthOn:aGC |
|
2063 "return the width of the receiver, if it is to be displayed on aGC |
|
2064 " |
|
2065 |additionalName| |
|
2066 |
|
2067 width isNil ifTrue:[ |
|
2068 width := self widthOf:(self label) on:aGC. |
|
2069 width := width + 2. |
|
2070 |
|
2071 additionalName := self additionalLabelForItem:self. |
|
2072 |
|
2073 additionalName notNil ifTrue:[ |
|
2074 xOffsetAdditionalName := width + 10. |
|
2075 width := xOffsetAdditionalName + (self widthOf:additionalName on:aGC). |
|
2076 width := width + 2. |
|
2077 ] ifFalse:[ |
|
2078 xOffsetAdditionalName := nil. |
|
2079 ]. |
|
2080 ]. |
|
2081 ^ width |
|
2082 ! ! |
|
2083 |
|
2084 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'enumerating'! |
|
2085 |
|
2086 handlesDo:aTwoArgAction |
|
2087 "evaluate the two arg block on each handle; the arguments to the block is |
|
2088 the rectangle relative to the rootView and the handle type which is |
|
2089 set to nil if not resizeable. |
|
2090 |
|
2091 TYPES: type position( X - Y ) |
|
2092 ------------------------- |
|
2093 #LT Left - Top |
|
2094 #LC Left - Center |
|
2095 #LB Left - Bottom |
|
2096 #CT Center - Top |
|
2097 #CB Center - Bottom |
|
2098 #RT Right - Top |
|
2099 #RC Right - Center |
|
2100 #RB Right - Bottom |
|
2101 |
|
2102 nil ** handle not pickable ** |
|
2103 " |
|
2104 |type relOrg relCrn maxExt rootView w h |
|
2105 xL "{ Class:SmallInteger }" |
|
2106 xC "{ Class:SmallInteger }" |
|
2107 xR "{ Class:SmallInteger }" |
|
2108 yT "{ Class:SmallInteger }" |
|
2109 yC "{ Class:SmallInteger }" |
|
2110 yB "{ Class:SmallInteger }" |
|
2111 | |
|
2112 rootView := self rootView. |
|
2113 relOrg := widget originRelativeTo:rootView. |
|
2114 relOrg isNil ifTrue:[ ^ self ]. "/ widget destroyed |
|
2115 |
|
2116 relOrg := relOrg - (HandleExtent // 2). |
|
2117 relCrn := relOrg + widget extent. |
|
2118 maxExt := rootView extent - HandleExtent. |
|
2119 |
|
2120 xL := relOrg x max:0. |
|
2121 xR := relCrn x min:(maxExt x). |
|
2122 xC := xR + xL // 2. |
|
2123 |
|
2124 yT := relOrg y max:0. |
|
2125 yB := relCrn y min:(maxExt y). |
|
2126 yC := yB + yT // 2. |
|
2127 |
|
2128 type := self layoutType. |
|
2129 w := HandleExtent x. |
|
2130 h := HandleExtent y. |
|
2131 |
|
2132 (type == #LayoutFrame or:[type == #Rectangle]) ifTrue:[ |
|
2133 aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:#LT. |
|
2134 aTwoArgAction value:(Rectangle left:xL top:yC width:w height:h) value:#LC. |
|
2135 aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:#LB. |
|
2136 aTwoArgAction value:(Rectangle left:xC top:yT width:w height:h) value:#CT. |
|
2137 aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB. |
|
2138 aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:#RT. |
|
2139 aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC. |
|
2140 aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB. |
|
2141 ^ self |
|
2142 ]. |
|
2143 |
|
2144 aTwoArgAction value:(Rectangle left:xL top:yT width:w height:h) value:nil. |
|
2145 aTwoArgAction value:(Rectangle left:xL top:yB width:w height:h) value:nil. |
|
2146 aTwoArgAction value:(Rectangle left:xR top:yT width:w height:h) value:nil. |
|
2147 |
|
2148 type == #Extent ifTrue:[ |
|
2149 aTwoArgAction value:(Rectangle left:xC top:yB width:w height:h) value:#CB. |
|
2150 aTwoArgAction value:(Rectangle left:xR top:yC width:w height:h) value:#RC. |
|
2151 aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:#RB. |
|
2152 ^ self |
|
2153 ]. |
|
2154 aTwoArgAction value:(Rectangle left:xR top:yB width:w height:h) value:nil. |
|
2155 ! |
|
2156 |
|
2157 recursiveEachVisibleItemDo:anOneArgBlock |
|
2158 "recursive evaluate the block on each child which is visible |
|
2159 " |
|
2160 (isExpanded and:[children size > 0]) ifTrue:[ |
|
2161 children do:[:aChild| |
|
2162 anOneArgBlock value:aChild. |
|
2163 aChild recursiveEachVisibleItemDo:anOneArgBlock. |
|
2164 ] |
|
2165 ]. |
|
2166 ! |
|
2167 |
|
2168 subViewsDo:aOneArgBlock |
|
2169 "evaluate aBlock for all subviews other than InputView's |
|
2170 " |
|
2171 |subViews| |
|
2172 |
|
2173 subViews := widget subViews. |
|
2174 |
|
2175 subViews notNil ifTrue:[ |
|
2176 subViews do:aOneArgBlock |
|
2177 ]. |
|
2178 ! ! |
|
2179 |
|
2180 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'initialization'! |
|
2181 |
|
2182 forView:aView |
|
2183 widget := aView. |
|
2184 ! |
|
2185 |
|
2186 initialize |
|
2187 "setup default attributes |
|
2188 " |
|
2189 super initialize. |
|
2190 isDrawnShown := false. |
|
2191 isExpanded := false. |
|
2192 children := OrderedCollection new. |
|
2193 ! ! |
|
2194 |
|
2195 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations delete'! |
|
2196 |
|
2197 delete |
|
2198 "delete self and all contained items; the assigned views are destroyed |
|
2199 in case of rootView, only the children are deleted |
|
2200 " |
|
2201 parent isHierarchicalItem ifTrue:[ |
|
2202 self criticalDo:[ |
|
2203 parent remove:self. |
|
2204 widget destroy. |
|
2205 ] |
|
2206 ] ifFalse:[ |
|
2207 self deleteAll |
|
2208 ]. |
|
2209 ! |
|
2210 |
|
2211 deleteAll |
|
2212 "delete all contained items; the assigned views are destroyed |
|
2213 " |
|
2214 children size == 0 ifTrue:[^ self]. |
|
2215 |
|
2216 self criticalDo:[ |
|
2217 self nonCriticalDo:[:el| el widget destroy ]. |
|
2218 self removeAll |
|
2219 ]. |
|
2220 ! ! |
|
2221 |
|
2222 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations layout'! |
|
2223 |
|
2224 asLayoutFrame |
|
2225 "convert the layout of the widget to a LayoutFrame; |
|
2226 " |
|
2227 |extent layout newLyt lftFrc lftOff topFrc topOff| |
|
2228 |
|
2229 layout := widget geometryLayout. |
|
2230 |
|
2231 layout isNil ifTrue:[ |
|
2232 ^ widget bounds asLayout |
|
2233 ]. |
|
2234 |
|
2235 layout isLayout ifFalse:[ |
|
2236 layout isRectangle ifTrue:[ |
|
2237 ^ LayoutFrame leftOffset:(layout left) rightOffset:(layout right) |
|
2238 topOffset:(layout top) bottomOffset:(layout bottom) |
|
2239 ]. |
|
2240 layout isPoint ifTrue:[ |
|
2241 extent := widget extent. |
|
2242 ^ LayoutFrame leftOffset:(layout x) rightOffset:(layout x + extent x) |
|
2243 topOffset:(layout y) bottomOffset:(layout y + extent y) |
|
2244 ]. |
|
2245 |
|
2246 Transcript showCR:'UNSUPPORTRD LAYOUT: ', layout printString. |
|
2247 ^ nil |
|
2248 ]. |
|
2249 |
|
2250 layout isLayoutFrame ifTrue:[ ^ layout copy ]. |
|
2251 |
|
2252 lftFrc := layout leftFraction. |
|
2253 lftOff := layout leftOffset. |
|
2254 topFrc := layout topFraction. |
|
2255 topOff := layout topOffset. |
|
2256 extent := widget extent. |
|
2257 |
|
2258 newLyt := LayoutFrame leftFraction:lftFrc offset:lftOff |
|
2259 rightFraction:lftFrc offset:(lftOff + extent x) |
|
2260 topFraction:topFrc offset:topOff |
|
2261 bottomFraction:topFrc offset:(topOff + extent y). |
|
2262 |
|
2263 ( layout isAlignmentOrigin |
|
2264 and:[(layout leftAlignmentFraction ~= 0 or:[layout topAlignmentFraction ~= 0])] |
|
2265 ) ifTrue:[ |
|
2266 |svRc prBd dlta| |
|
2267 |
|
2268 svRc := widget superView viewRectangle. |
|
2269 prBd := widget preferredBounds. |
|
2270 |
|
2271 dlta := ( ((layout rectangleRelativeTo:svRc preferred:prBd) corner) |
|
2272 - ((newLyt rectangleRelativeTo:svRc preferred:prBd) corner) |
|
2273 ) rounded. |
|
2274 |
|
2275 newLyt leftOffset:(lftOff + dlta x). |
|
2276 newLyt rightOffset:(lftOff + extent x + dlta x). |
|
2277 newLyt topOffset:(topOff + dlta y). |
|
2278 newLyt bottomOffset:(topOff + extent y + dlta y). |
|
2279 ]. |
|
2280 ^ newLyt |
|
2281 ! |
|
2282 |
|
2283 moveLeft:l top:t |
|
2284 "move the widget n pixele left and right |
|
2285 " |
|
2286 |layout| |
|
2287 |
|
2288 self isMoveable ifFalse:[ ^ self ]. |
|
2289 |
|
2290 (layout := widget geometryLayout) isNil ifTrue:[ |
|
2291 "Extent" |
|
2292 widget origin:(widget origin + (l@t)). |
|
2293 ^ self |
|
2294 ]. |
|
2295 |
|
2296 layout := layout copy. |
|
2297 |
|
2298 layout isLayout ifTrue:[ |
|
2299 layout leftOffset:(layout leftOffset + l) |
|
2300 topOffset:(layout topOffset + t). |
|
2301 |
|
2302 layout isLayoutFrame ifTrue:[ |
|
2303 layout rightOffset:(layout rightOffset + l). |
|
2304 layout bottomOffset:(layout bottomOffset + t). |
|
2305 ] |
|
2306 |
|
2307 ] ifFalse:[ |
|
2308 layout isRectangle ifTrue:[ |
|
2309 layout setLeft:(layout left + l). |
|
2310 layout setTop:(layout top + t). |
|
2311 ] ifFalse:[ |
|
2312 layout isPoint ifFalse:[^ self]. |
|
2313 layout x:(layout x + l) y:(layout y + t). |
|
2314 ] |
|
2315 ]. |
|
2316 widget geometryLayout:layout. |
|
2317 ! |
|
2318 |
|
2319 resizeLeft:l top:t right:r bottom:b |
|
2320 "resize the widget measured in pixels |
|
2321 " |
|
2322 |layout| |
|
2323 |
|
2324 self isResizeable ifFalse:[ |
|
2325 ^ self |
|
2326 ]. |
|
2327 |
|
2328 (layout := widget geometryLayout) isNil ifTrue:[ |
|
2329 "Extent" |
|
2330 (r == l and:[b == t]) ifFalse:[ |
|
2331 widget extent:(widget computeExtent + ((r-l) @ (b-t))). |
|
2332 ]. |
|
2333 ^ self |
|
2334 ]. |
|
2335 |
|
2336 layout isLayout ifTrue:[ |
|
2337 layout := layout copy. |
|
2338 |
|
2339 layout leftOffset:(layout leftOffset + l) |
|
2340 topOffset:(layout topOffset + t). |
|
2341 |
|
2342 layout isLayoutFrame ifTrue:[ |
|
2343 layout bottomOffset:(layout bottomOffset + b). |
|
2344 layout rightOffset:(layout rightOffset + r). |
|
2345 ] |
|
2346 ] ifFalse:[ |
|
2347 layout isRectangle ifFalse:[^ self]. |
|
2348 layout := layout copy. |
|
2349 |
|
2350 layout left:(layout left + l) |
|
2351 right:(layout right + r) |
|
2352 top:(layout top + t) |
|
2353 bottom:(layout bottom + b). |
|
2354 ]. |
|
2355 widget geometryLayout:layout. |
|
2356 ! ! |
|
2357 |
|
2358 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'operations update'! |
|
2359 |
|
2360 updateChildren |
|
2361 |list| |
|
2362 |
|
2363 self do:[:el| |
|
2364 el exists ifTrue:[ |
|
2365 el updateChildren. |
|
2366 ] ifFalse:[ |
|
2367 list isNil ifTrue:[list := OrderedCollection new]. |
|
2368 list add:el. |
|
2369 ] |
|
2370 ]. |
|
2371 list notNil ifTrue:[ |
|
2372 list do:[:el| self remove:el ]. |
|
2373 ]. |
|
2374 ! |
|
2375 |
|
2376 updateFromChildren:mergedList |
|
2377 "update my children against the list of items derived from |
|
2378 the merged list. |
|
2379 " |
|
2380 |
|
2381 mergedList size == 0 ifTrue:[ ^ self removeAll ]. |
|
2382 children size == 0 ifTrue:[ ^ self addAll:mergedList ]. |
|
2383 |
|
2384 self criticalDo:[ |
|
2385 self nonCriticalDo:[:el| |wdg| |
|
2386 wdg := el widget. |
|
2387 mergedList detect:[:e2| e2 widget == wdg ] ifNone:[ self remove:el ]. |
|
2388 ]. |
|
2389 |
|
2390 mergedList keysAndValuesDo:[:i :el| |wdg e2| |
|
2391 wdg := el widget. |
|
2392 |
|
2393 e2 := self at:i ifAbsent:nil. |
|
2394 |
|
2395 (e2 isNil or:[e2 widget ~~ wdg]) ifTrue:[ |
|
2396 self add:el beforeIndex:i |
|
2397 ] |
|
2398 ] |
|
2399 ]. |
|
2400 ! ! |
|
2401 |
|
2402 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'printing & storing'! |
|
2403 |
|
2404 icon |
|
2405 "get the icon used for presentation |
|
2406 " |
|
2407 |specClass model| |
|
2408 |
|
2409 specClass := self specClass. |
|
2410 specClass isNil ifTrue:[^ nil]. |
|
2411 |
|
2412 model := self treeModel. |
|
2413 |
|
2414 model notNil ifTrue:[ |
|
2415 ^ model iconAt:specClass ifNonePut:[specClass icon] |
|
2416 ]. |
|
2417 ^ specClass icon |
|
2418 ! |
|
2419 |
|
2420 label |
|
2421 "get the label used for presentation |
|
2422 " |
|
2423 ^ self string |
|
2424 ! |
|
2425 |
|
2426 printOn:aStream |
|
2427 "append a a printed representation of the item to aStream |
|
2428 " |
|
2429 aStream nextPutAll:(self string) |
|
2430 ! |
|
2431 |
|
2432 string |
|
2433 "get the string |
|
2434 " |
|
2435 ^ widget class name. |
|
2436 ! ! |
|
2437 |
|
2438 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'queries'! |
|
2439 |
|
2440 canChangeLayout |
|
2441 "returns true if the layout of the widget can be changed and the |
|
2442 layout is not organized by its superView |
|
2443 " |
|
2444 ^ self isResizeable |
|
2445 ! |
|
2446 |
|
2447 canResizeSubComponents |
|
2448 "returns true if the widget can resize its sub components |
|
2449 " |
|
2450 |specClass| |
|
2451 |
|
2452 specClass := self specClass. |
|
2453 |
|
2454 specClass notNil ifTrue:[ |
|
2455 ^ specClass canResizeSubComponents |
|
2456 ]. |
|
2457 ^ false |
|
2458 ! |
|
2459 |
|
2460 exists |
|
2461 widget id notNil ifTrue:[^ true ]. |
|
2462 |
|
2463 exists ~~ false ifTrue:[ |
|
2464 exists := false. |
|
2465 |
|
2466 widget superView notNil ifTrue:[ |
|
2467 (parent isHierarchicalItem and:[parent exists]) ifTrue:[ |
|
2468 exists := (parent widget subViews includesIdentical:widget). |
|
2469 ]. |
|
2470 ]. |
|
2471 ]. |
|
2472 ^ exists |
|
2473 ! |
|
2474 |
|
2475 isApplicationClass |
|
2476 |cls| |
|
2477 |
|
2478 cls := widget class. |
|
2479 |
|
2480 ^ ( cls == ApplicationSubView |
|
2481 or:[cls == ApplicationWindow |
|
2482 or:[cls == SubCanvas]] |
|
2483 ) |
|
2484 ! |
|
2485 |
|
2486 isSelected |
|
2487 |model| |
|
2488 |
|
2489 model := self treeModel. |
|
2490 model notNil ifTrue:[^ model isSelected:self]. |
|
2491 ^ false |
|
2492 ! |
|
2493 |
|
2494 supportsSubComponents |
|
2495 "returns true if the widget supports sub components |
|
2496 " |
|
2497 |specClass| |
|
2498 |
|
2499 widget isScrollWrapper ifTrue:[ |
|
2500 ^ false |
|
2501 ]. |
|
2502 specClass := self specClass. |
|
2503 |
|
2504 specClass notNil ifTrue:[ |
|
2505 ^ specClass supportsSubComponents |
|
2506 ]. |
|
2507 ^ false |
|
2508 ! ! |
|
2509 |
|
2510 !ViewTreeInspectorApplication::ViewTreeItem methodsFor:'testing'! |
|
2511 |
|
2512 isInLayoutContainer |
|
2513 "returns true if the widget is in a layout container |
|
2514 " |
|
2515 |sv specClass| |
|
2516 |
|
2517 sv := widget superView. |
|
2518 |
|
2519 sv notNil ifTrue:[ |
|
2520 specClass := sv specClass. |
|
2521 |
|
2522 specClass notNil ifTrue:[ |
|
2523 ^ specClass isLayoutContainer |
|
2524 ]. |
|
2525 ]. |
|
2526 ^ false |
|
2527 ! |
|
2528 |
|
2529 isLayoutContainer |
|
2530 "answer whether corresponding view instances of the spec class can contain |
|
2531 (and arrange) other view |
|
2532 " |
|
2533 |specClass| |
|
2534 |
|
2535 specClass := self specClass. |
|
2536 |
|
2537 specClass notNil ifTrue:[ |
|
2538 ^ specClass isLayoutContainer |
|
2539 ]. |
|
2540 ^ false |
|
2541 ! |
|
2542 |
|
2543 isMoveable |
|
2544 "returns true if the widget is not in a layout container |
|
2545 " |
|
2546 self isInLayoutContainer ifFalse:[ |
|
2547 ^ widget superView notNil |
|
2548 ]. |
|
2549 ^ false |
|
2550 ! |
|
2551 |
|
2552 isResizeable |
|
2553 "returns true if the widget is resizeable |
|
2554 " |
|
2555 |sv specClass| |
|
2556 |
|
2557 sv := widget superView. |
|
2558 |
|
2559 sv notNil ifTrue:[ |
|
2560 specClass := sv specClass. |
|
2561 |
|
2562 specClass notNil ifTrue:[ |
|
2563 ^ specClass canResizeSubComponents |
|
2564 ]. |
|
2565 ]. |
|
2566 ^ false |
|
2567 ! ! |
|
2568 |
|
2569 !ViewTreeInspectorApplication::ViewTreeModel class methodsFor:'documentation'! |
|
2570 |
|
2571 documentation |
|
2572 " |
|
2573 Instances of ViewTreeModel can be used as model on a View and all |
|
2574 it contained subviews for a HierarchicalListView. |
|
2575 The model keeps two values, the hierarchical representation of the views |
|
2576 and subviews (ViewTreeItems) and the selection, a list of selected ViewTreeItems's. |
|
2577 It shows the selected items highlighted. |
|
2578 |
|
2579 |
|
2580 [Instance variables:] |
|
2581 lockSema <Semaphore> lock selection notifications and redraws |
|
2582 |
|
2583 testModeChannel <ValueHolder> true, than running in test mode. |
|
2584 |
|
2585 hasTargetWidgetChannel <ValueHolder> true, than any target view is grapped |
|
2586 |
|
2587 selection <Sequence or nil> selected items or nil |
|
2588 |
|
2589 hiddenLevel <Integer> internal use; redrawing the selection |
|
2590 only is done if the counter is 0. |
|
2591 |
|
2592 listOfItems <HierarchicalList> hiearchical list build from existing items. |
|
2593 |
|
2594 selectedSuperItems <Sequence> list of selected super items; items selected |
|
2595 but not contained in another selected item. |
|
2596 |
|
2597 inputEventAction <Action> called for each InputEvent |
|
2598 |
|
2599 mappedViewAction <Action> called for a new mapped view which |
|
2600 can not be found in the current item list. |
|
2601 |
|
2602 beforeSelectionChangedAction <Action> called before the selection changed |
|
2603 |
|
2604 [author:] |
|
2605 Claus Atzkern |
|
2606 |
|
2607 [see also:] |
|
2608 ViewTreeItem |
|
2609 " |
|
2610 ! |
|
2611 |
|
2612 examples |
|
2613 " |
|
2614 example 1: pick any window and show views and contained views |
|
2615 [exBegin] |
|
2616 |top sel model panel| |
|
2617 |
|
2618 model := ViewTreeModel new. |
|
2619 top := StandardSystemView new; extent:440@400. |
|
2620 sel := ScrollableView for:HierarchicalListView miniScroller:true origin:0.0@0.0 corner:1.0@1.0 in:top. |
|
2621 sel bottomInset:24. |
|
2622 |
|
2623 panel := HorizontalPanelView origin:0.0@1.0 corner:1.0@1.0 in:top. |
|
2624 panel topInset:-24. |
|
2625 panel horizontalLayout:#fitSpace. |
|
2626 |
|
2627 Button label:'Exit' action:[model rootItem:nil. top destroy] in:panel. |
|
2628 Button label:'Pick Views' action:[ |win| |
|
2629 ( (win := Screen current viewFromUser) notNil |
|
2630 and:[(win := win topView) ~~ Screen current rootView |
|
2631 and:[win ~~ top]] |
|
2632 ) ifTrue:[ |
|
2633 model rootItem:(ViewTreeItem buildViewsFrom:win) |
|
2634 ] ifFalse:[ |
|
2635 model rootItem:nil |
|
2636 ] |
|
2637 ] in:panel. |
|
2638 |
|
2639 sel multipleSelectOk:true. |
|
2640 sel list:model listOfItems. |
|
2641 sel model:model. |
|
2642 sel useIndex:false. |
|
2643 |
|
2644 sel doubleClickAction:[:i| |el| |
|
2645 el := model listOfItems at:i. |
|
2646 el spec notNil ifTrue:[ el spec inspect ] ifFalse:[ el widget inspect ] |
|
2647 ]. |
|
2648 sel indicatorAction:[:i| (model listOfItems at:i) toggleExpand ]. |
|
2649 |
|
2650 model inputEventAction:[:anEvent| |item| |
|
2651 anEvent isButtonEvent ifTrue:[ |
|
2652 anEvent isButtonPressEvent ifTrue:[ |
|
2653 model selectedItem:(model listOfItems detectItemRespondsToView:(anEvent view)). |
|
2654 ] ifFalse:[ |
|
2655 anEvent type == #'buttonMultiPress:x:y:' ifTrue:[ |
|
2656 (item := model selectedItem) notNil ifTrue:[item widget inspect] |
|
2657 ] |
|
2658 ] |
|
2659 ] |
|
2660 ]. |
|
2661 |
|
2662 top openAndWait. |
|
2663 [[top shown] whileTrue:[Delay waitForSeconds:0.5]. model rootItem:nil] forkAt:8 |
|
2664 |
|
2665 [exEnd] |
|
2666 " |
|
2667 ! ! |
|
2668 |
|
2669 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing'! |
|
2670 |
|
2671 application:anApplication |
|
2672 listOfItems application:anApplication. |
|
2673 ! |
|
2674 |
|
2675 rootItem |
|
2676 "get the rootItem the event viewer is established on |
|
2677 " |
|
2678 ^ listOfItems root |
|
2679 ! |
|
2680 |
|
2681 rootItem:anItem |
|
2682 "set the rootItem the event viewer is established on |
|
2683 " |
|
2684 |expanded| |
|
2685 |
|
2686 timedUpdateTask := nil. |
|
2687 self deselect. |
|
2688 |
|
2689 lockSema critical:[ |
|
2690 anItem notNil ifTrue:[ expanded := anItem isExpanded ] |
|
2691 ifFalse:[ expanded := false ]. |
|
2692 |
|
2693 self value:nil. |
|
2694 listOfItems root:anItem. |
|
2695 |
|
2696 anItem notNil ifTrue:[ |
|
2697 timedUpdateTask := Process for:[ self timedUpdateTaskCycle ] priority:8. |
|
2698 timedUpdateTask name:'Update'. |
|
2699 timedUpdateTask resume. |
|
2700 ]. |
|
2701 ]. |
|
2702 |
|
2703 (expanded and:[anItem notNil]) ifTrue:[ |
|
2704 anItem expand |
|
2705 ]. |
|
2706 ^ anItem |
|
2707 ! |
|
2708 |
|
2709 rootView |
|
2710 "get the top widget the event viewer is established on, a View |
|
2711 " |
|
2712 ^ listOfItems rootView |
|
2713 ! ! |
|
2714 |
|
2715 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing actions'! |
|
2716 |
|
2717 beforeSelectionChangedAction |
|
2718 "none argument action which is called before |
|
2719 the selection changed |
|
2720 " |
|
2721 ^ beforeSelectionChangedAction |
|
2722 ! |
|
2723 |
|
2724 beforeSelectionChangedAction:aNoneArgBlock |
|
2725 "none argument action which is called before |
|
2726 the selection changed |
|
2727 " |
|
2728 beforeSelectionChangedAction := aNoneArgBlock. |
|
2729 ! |
|
2730 |
|
2731 inputEventAction |
|
2732 "called for each input event; the argument to the action is the WindowEvent |
|
2733 " |
|
2734 ^ inputEventAction |
|
2735 ! |
|
2736 |
|
2737 inputEventAction:aOneArgActionTheEvent |
|
2738 "called for each input event; the argument to the action is the WindowEvent |
|
2739 " |
|
2740 inputEventAction := aOneArgActionTheEvent. |
|
2741 ! |
|
2742 |
|
2743 mappedViewAction |
|
2744 "called for a new mapped view which can not be found |
|
2745 in the current item list |
|
2746 " |
|
2747 ^ mappedViewAction |
|
2748 ! |
|
2749 |
|
2750 mappedViewAction:aOneArgBlockTheMappedView |
|
2751 "called for a new mapped view which can not be found |
|
2752 in the current item list |
|
2753 " |
|
2754 mappedViewAction := aOneArgBlockTheMappedView |
|
2755 ! ! |
|
2756 |
|
2757 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing look'! |
|
2758 |
|
2759 iconAt:aKey ifNonePut:aNoneArgBlock |
|
2760 |icon view| |
|
2761 |
|
2762 icon := icons at:aKey ifAbsent:nil. |
|
2763 icon notNil ifTrue:[^ icon]. |
|
2764 |
|
2765 icon := aNoneArgBlock value. |
|
2766 icon isNil ifTrue:[^ nil]. |
|
2767 |
|
2768 view := self rootView. |
|
2769 view isNil ifTrue:[^ icon]. |
|
2770 |
|
2771 icon := icon copy onDevice:(view device). |
|
2772 icon isImage ifTrue:[ |
|
2773 icon clearMaskedPixels. |
|
2774 ]. |
|
2775 icons at:aKey put:icon. |
|
2776 ^ icon |
|
2777 ! ! |
|
2778 |
|
2779 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'accessing visibility'! |
|
2780 |
|
2781 signalHiddenLevel |
|
2782 "show the selection if signaled; increments hiddenLevel |
|
2783 see: #waitHiddenLevel |
|
2784 " |
|
2785 (hiddenLevel := hiddenLevel - 1) < 1 ifTrue:[ |
|
2786 hiddenLevel := 0. |
|
2787 self invalidateSelection. |
|
2788 ]. |
|
2789 ! |
|
2790 |
|
2791 waitHiddenLevel |
|
2792 "hide the selection until signaled; increments hiddenLevel |
|
2793 see: #signalHiddenLevel |
|
2794 " |
|
2795 self redrawUnselected:selection andLock:true |
|
2796 ! |
|
2797 |
|
2798 withSelectionHiddenDo:aNoneArgumentBlock |
|
2799 "apply block with selection hidden |
|
2800 " |
|
2801 |
|
2802 [ self waitHiddenLevel. |
|
2803 |
|
2804 aNoneArgumentBlock value |
|
2805 |
|
2806 ] valueNowOrOnUnwindDo:[ |
|
2807 self signalHiddenLevel. |
|
2808 ]. |
|
2809 ! ! |
|
2810 |
|
2811 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'aspects'! |
|
2812 |
|
2813 hasTargetWidgetChannel |
|
2814 "answer the channel which is set to true if a target widget exists" |
|
2815 |
|
2816 ^ hasTargetWidgetChannel |
|
2817 ! |
|
2818 |
|
2819 listOfItems |
|
2820 "hiearchical list build from existing items" |
|
2821 |
|
2822 ^ listOfItems |
|
2823 ! |
|
2824 |
|
2825 selectOnClickHolder |
|
2826 "boolean holder, which indicates whether the selection will change on click |
|
2827 " |
|
2828 ^ selectOnClickHolder |
|
2829 ! |
|
2830 |
|
2831 testModeChannel |
|
2832 "answer a boolean channel which describes the behaviour how to process |
|
2833 events on the target view. |
|
2834 |
|
2835 false: all input events are eaten and the selection is shown on the target view. |
|
2836 true: no input events are eaten and no selection is shown on the target view." |
|
2837 |
|
2838 ^ testModeChannel |
|
2839 ! ! |
|
2840 |
|
2841 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'change & update'! |
|
2842 |
|
2843 targetWidgetChanged |
|
2844 hasTargetWidgetChannel value:(self rootItem notNil). |
|
2845 ! |
|
2846 |
|
2847 timedUpdateTaskCycle |
|
2848 |view myTaskId| |
|
2849 |
|
2850 myTaskId := timedUpdateTask. |
|
2851 |
|
2852 listOfItems root notNil ifTrue:[ |
|
2853 view := listOfItems root widget. |
|
2854 ]. |
|
2855 |
|
2856 [ view notNil ] whileTrue:[ |
|
2857 Delay waitForSeconds:0.5. |
|
2858 |
|
2859 (myTaskId == timedUpdateTask and:[view id notNil]) ifFalse:[ |
|
2860 view := nil. |
|
2861 ] ifTrue:[ |
|
2862 (view sensor hasUserEvent:#updateChildren for:self) ifFalse:[ |
|
2863 view sensor pushUserEvent:#updateChildren for:self. |
|
2864 ]. |
|
2865 ]. |
|
2866 ]. |
|
2867 timedUpdateTask == myTaskId ifTrue:[ |
|
2868 timedUpdateTask := nil. |
|
2869 listOfItems root:nil. |
|
2870 ]. |
|
2871 ! |
|
2872 |
|
2873 update:something with:someArgument from:aModel |
|
2874 |
|
2875 aModel == testModeChannel ifTrue:[ |
|
2876 (hiddenLevel == 0 and:[selection size > 0]) ifTrue:[ |
|
2877 testModeChannel value ifTrue:[ |
|
2878 self redrawUnselected:selection andLock:false checkTestMode:false. |
|
2879 ] ifFalse:[ |
|
2880 self invalidateSelection. |
|
2881 ]. |
|
2882 ]. |
|
2883 ^ self |
|
2884 ]. |
|
2885 super update:something with:someArgument from:aModel. |
|
2886 ! |
|
2887 |
|
2888 updateChildren |
|
2889 |rootItem| |
|
2890 |
|
2891 rootItem := listOfItems root. |
|
2892 rootItem isNil ifTrue:[^ self]. |
|
2893 |
|
2894 rootItem exists ifFalse:[ |
|
2895 listOfItems root:nil. |
|
2896 ] ifTrue:[ |
|
2897 rootItem updateChildren. |
|
2898 ]. |
|
2899 ! ! |
|
2900 |
|
2901 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'event processing'! |
|
2902 |
|
2903 processEvent:anEvent |
|
2904 "catch and process all WindowEvents for the rootComponent and its contained |
|
2905 widgets; redraw selection in case of damage .... |
|
2906 " |
|
2907 |evView item rootView testMode| |
|
2908 |
|
2909 evView := anEvent view. |
|
2910 evView isNil ifTrue:[ |
|
2911 (anEvent isMessageSendEvent and:[anEvent receiver == self]) ifFalse:[ |
|
2912 ^ false |
|
2913 ]. |
|
2914 anEvent value. |
|
2915 ^ true. |
|
2916 ]. |
|
2917 rootView := listOfItems rootView. |
|
2918 rootView isNil ifTrue:[ ^ false ]. |
|
2919 |
|
2920 anEvent isConfigureEvent ifTrue:[ |
|
2921 hiddenLevel == 0 ifTrue:[ |
|
2922 self redrawUnselected:selection andLock:false. |
|
2923 ]. |
|
2924 ^ false |
|
2925 ]. |
|
2926 |
|
2927 "/ check whether view is contained within the rootView |
|
2928 (evView == rootView or:[evView isComponentOf:rootView]) ifFalse:[ |
|
2929 ^ false |
|
2930 ]. |
|
2931 |
|
2932 anEvent isInputEvent ifFalse:[ |
|
2933 anEvent isDamage ifTrue:[ |
|
2934 hiddenLevel == 0 ifTrue:[self invalidateSelection]. |
|
2935 ^ false |
|
2936 ]. |
|
2937 |
|
2938 anEvent isMapEvent ifTrue:[ |
|
2939 mappedViewAction notNil ifTrue:[ |
|
2940 item := listOfItems recursiveDetect:[:el| el widget == evView]. |
|
2941 item isNil ifTrue:[ mappedViewAction value:evView ] |
|
2942 ]. |
|
2943 ^ false |
|
2944 ]. |
|
2945 |
|
2946 anEvent type == #terminate ifTrue:[ |
|
2947 item := listOfItems recursiveDetect:[:el| el widget == evView]. |
|
2948 item notNil ifTrue:[ self processTerminateForItem:item ]. |
|
2949 ^ false |
|
2950 ]. |
|
2951 ^ false |
|
2952 ]. |
|
2953 testMode := testModeChannel value. |
|
2954 |
|
2955 anEvent isFocusEvent ifTrue:[ |
|
2956 evView == rootView ifTrue:[ |
|
2957 self invalidateSelection |
|
2958 ]. |
|
2959 ^ testMode not. |
|
2960 ]. |
|
2961 anEvent isPointerEnterLeaveEvent ifTrue:[ ^ testMode not ]. |
|
2962 |
|
2963 testMode ifFalse:[ |
|
2964 inputEventAction notNil ifTrue:[ inputEventAction value:anEvent ]. |
|
2965 ] ifTrue:[ |
|
2966 anEvent isButtonPressEvent ifTrue:[ |
|
2967 selectOnClickHolder value ifTrue:[ |
|
2968 self selectItem:(listOfItems detectItemRespondsToView:evView). |
|
2969 ]. |
|
2970 ] |
|
2971 ]. |
|
2972 |
|
2973 (hiddenLevel ~~ 0 and:[anEvent isButtonReleaseEvent]) ifTrue:[ |
|
2974 hiddenLevel := 1. |
|
2975 self signalHiddenLevel. |
|
2976 ]. |
|
2977 |
|
2978 ^ testMode not |
|
2979 ! |
|
2980 |
|
2981 processTerminateForItem:anItem |
|
2982 "received terminate for an item |
|
2983 " |
|
2984 anItem remove. |
|
2985 ! ! |
|
2986 |
|
2987 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'initialization'! |
|
2988 |
|
2989 initialize |
|
2990 "setup the default attributes |
|
2991 " |
|
2992 super initialize. |
|
2993 |
|
2994 hiddenLevel := 0. |
|
2995 lockSema := RecursionLock new. |
|
2996 listOfItems := ItemList new on:self. |
|
2997 selectedSuperItems := #(). |
|
2998 icons := IdentityDictionary new. |
|
2999 |
|
3000 hasTargetWidgetChannel := false asValue. |
|
3001 selectOnClickHolder := true asValue. |
|
3002 |
|
3003 testModeChannel := false asValue. |
|
3004 testModeChannel addDependent:self. |
|
3005 ! ! |
|
3006 |
|
3007 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'private selection'! |
|
3008 |
|
3009 invalidateSelection |
|
3010 "invalidate the current selection |
|
3011 " |
|
3012 |topView| |
|
3013 |
|
3014 testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode |
|
3015 |
|
3016 ( hiddenLevel == 0 |
|
3017 and:[selection notNil |
|
3018 and:[(topView := listOfItems rootView) notNil |
|
3019 and:[topView shown]]] |
|
3020 ) ifTrue:[ |
|
3021 topView sensor pushUserEvent:#redrawSelection for:self withArguments:#() |
|
3022 ] |
|
3023 ! |
|
3024 |
|
3025 recursiveRepair:theDamages startIn:aView relativeTo:aRootView |
|
3026 "repair all views and contained views, which intersects the damage. |
|
3027 !!!! all damages repaired are removed from the list of damages !!!! |
|
3028 " |
|
3029 |color relOrg damage subViews repaired |
|
3030 bwWidth "{ Class:SmallInteger }" |
|
3031 x "{ Class:SmallInteger }" |
|
3032 y "{ Class:SmallInteger }" |
|
3033 w "{ Class:SmallInteger }" |
|
3034 h "{ Class:SmallInteger }" |
|
3035 relOrgX "{ Class:SmallInteger }" |
|
3036 relOrgY "{ Class:SmallInteger }" |
|
3037 width "{ Class:SmallInteger }" |
|
3038 height "{ Class:SmallInteger }" |
|
3039 size "{ Class:SmallInteger }" |
|
3040 | |
|
3041 (aView shown and:[theDamages notEmpty]) ifFalse:[ ^ self ]. |
|
3042 |
|
3043 subViews := aView subViews. |
|
3044 |
|
3045 subViews size ~~ 0 ifTrue:[ |
|
3046 subViews reverseDo:[:v| self recursiveRepair:theDamages startIn:v relativeTo:aRootView ]. |
|
3047 theDamages isEmpty ifTrue:[ ^ self ]. |
|
3048 ]. |
|
3049 |
|
3050 relOrg := aView originRelativeTo:aRootView. |
|
3051 bwWidth := aView borderWidth. |
|
3052 size := theDamages size. |
|
3053 |
|
3054 "/ compute relative origin starting from border left@top |
|
3055 relOrgX := relOrg x - bwWidth. |
|
3056 relOrgY := relOrg y - bwWidth. |
|
3057 width := aView width + bwWidth + bwWidth. |
|
3058 height := aView height + bwWidth + bwWidth. |
|
3059 |
|
3060 size to:1 by:-1 do:[:anIndex| |
|
3061 repaired := damage := theDamages at:anIndex. |
|
3062 |
|
3063 "/ compute the rectangle into the view |
|
3064 y := damage top - relOrgY. |
|
3065 x := damage left - relOrgX. |
|
3066 w := damage width. |
|
3067 h := damage height. |
|
3068 |
|
3069 x < 0 ifTrue:[ w := w + x. x := 0. repaired := nil ]. |
|
3070 y < 0 ifTrue:[ h := h + y. y := 0. repaired := nil ]. |
|
3071 x + w > width ifTrue:[ w := width - x. repaired := nil ]. |
|
3072 y + h > height ifTrue:[ h := height - y. repaired := nil ]. |
|
3073 |
|
3074 (w > 0 and:[h > 0]) ifTrue:[ |
|
3075 bwWidth ~~ 0 ifTrue:[ |
|
3076 color isNil ifTrue:[ |
|
3077 "/ must force redraw of border |
|
3078 color := aView borderColor. |
|
3079 aView borderColor:(Color colorId:1). |
|
3080 aView borderColor:color. |
|
3081 ]. |
|
3082 w := w - bwWidth. |
|
3083 h := h - bwWidth. |
|
3084 |
|
3085 (x := x - bwWidth) < 0 ifTrue:[w := w + x. x := 0]. |
|
3086 (y := y - bwWidth) < 0 ifTrue:[h := h + y. y := 0]. |
|
3087 |
|
3088 h > 0 ifFalse:[w := 0]. "/ later testing on width only |
|
3089 ]. |
|
3090 |
|
3091 w > 0 ifTrue:[ |
|
3092 aView clearRectangleX:x y:y width:w height:h. |
|
3093 aView exposeX:x y:y width:w height:h |
|
3094 ]. |
|
3095 repaired notNil ifTrue:[ theDamages removeFromIndex:anIndex toIndex:anIndex ]. |
|
3096 ] |
|
3097 ]. |
|
3098 ! |
|
3099 |
|
3100 redrawSelection |
|
3101 "redraw all items selected |
|
3102 " |
|
3103 |topView size| |
|
3104 |
|
3105 testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode |
|
3106 |
|
3107 ( hiddenLevel == 0 |
|
3108 and:[(size := selection size) > 0 |
|
3109 and:[(topView := listOfItems rootView) notNil |
|
3110 and:[topView shown |
|
3111 and:[(topView sensor hasEvent:#redrawSelection for:self) not]]]] |
|
3112 ) ifFalse:[ |
|
3113 ^ self |
|
3114 ]. |
|
3115 |
|
3116 lockSema critical:[ |
|
3117 |list| |
|
3118 |
|
3119 list := selection. |
|
3120 |
|
3121 list size > 0 ifTrue:[ |
|
3122 topView paint:(Color black). |
|
3123 topView clippedByChildren:false. |
|
3124 |
|
3125 list keysAndValuesReverseDo:[:anIndex :anItem| |
|
3126 (anIndex == 1 and:[size > 1]) ifTrue:[ topView paint:(Color red) ]. |
|
3127 |
|
3128 anItem handlesDo:[:aRect :what| |
|
3129 what isNil ifTrue:[topView displayRectangle:aRect] |
|
3130 ifFalse:[topView fillRectangle:aRect] |
|
3131 ] |
|
3132 ]. |
|
3133 topView clippedByChildren:true. |
|
3134 ]. |
|
3135 ]. |
|
3136 ! |
|
3137 |
|
3138 redrawUnselected:aList andLock:doLock |
|
3139 "redraw all items unselected; if doLock is true, the hiddenLevel |
|
3140 is incremented and thus the select mechanism is locked. |
|
3141 " |
|
3142 self redrawUnselected:aList andLock:doLock checkTestMode:true. |
|
3143 ! |
|
3144 |
|
3145 redrawUnselected:aList andLock:doLock checkTestMode:checkTestMode |
|
3146 "redraw all items unselected; if doLock is true, the hiddenLevel |
|
3147 is incremented and thus the select mechanism is locked. |
|
3148 " |
|
3149 |rootView damages subViews x y w h| |
|
3150 |
|
3151 doLock ifTrue:[ |
|
3152 hiddenLevel := hiddenLevel + 1. |
|
3153 hiddenLevel ~~ 1 ifTrue:[^ self]. |
|
3154 ] ifFalse:[ |
|
3155 hiddenLevel ~~ 0 ifTrue:[^ self]. |
|
3156 ]. |
|
3157 checkTestMode ifTrue:[ |
|
3158 testModeChannel value ifTrue:[ ^ self ]. "/ test whether running testMode |
|
3159 ]. |
|
3160 |
|
3161 ( aList size ~~ 0 |
|
3162 and:[(rootView := listOfItems rootView) notNil |
|
3163 and:[rootView shown]] |
|
3164 ) ifFalse:[ |
|
3165 ^ self |
|
3166 ]. |
|
3167 |
|
3168 lockSema critical:[ |
|
3169 damages := OrderedCollection new:(8 * aList size). |
|
3170 |
|
3171 aList do:[:item| |
|
3172 item handlesDo:[:handle :what| |
|
3173 damages reverseDo:[:el| |
|
3174 (el intersects:handle) ifTrue:[ |
|
3175 damages removeIdentical:el. |
|
3176 |
|
3177 handle left:(handle left min:el left) |
|
3178 right:(handle right max:el right) |
|
3179 top:(handle top min:el top) |
|
3180 bottom:(handle bottom max:el bottom) |
|
3181 ] |
|
3182 ]. |
|
3183 damages add:handle |
|
3184 ] |
|
3185 ]. |
|
3186 |
|
3187 damages do:[:el| |
|
3188 x := el left. |
|
3189 y := el top. |
|
3190 w := el width. |
|
3191 h := el height. |
|
3192 |
|
3193 rootView clearRectangleX:x y:y width:w height:h. |
|
3194 rootView exposeX:x y:y width:w height:h. |
|
3195 ]. |
|
3196 |
|
3197 (subViews := rootView subViews) notNil ifTrue:[ |
|
3198 subViews reverseDo:[:v| self recursiveRepair:damages startIn:v relativeTo:rootView ]. |
|
3199 ]. |
|
3200 ]. |
|
3201 ! ! |
|
3202 |
|
3203 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'queries'! |
|
3204 |
|
3205 isInTestMode |
|
3206 "answer false, all input events are eaten and the selection is shown on the target view. |
|
3207 answer true, no input events are eaten and no selection is shown on the target view." |
|
3208 |
|
3209 ^ testModeChannel value |
|
3210 ! ! |
|
3211 |
|
3212 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection accessing'! |
|
3213 |
|
3214 at:anIndex |
|
3215 "returns the selected item at an index or nil |
|
3216 " |
|
3217 selection notNil ifTrue:[ |
|
3218 ^ selection at:anIndex ifAbsent:nil |
|
3219 ]. |
|
3220 ^ nil |
|
3221 ! |
|
3222 |
|
3223 at:anIndex ifAbsent:aBlock |
|
3224 "returns the selected item at an index or the result of the block |
|
3225 " |
|
3226 selection notNil ifTrue:[ |
|
3227 ^ selection at:anIndex ifAbsent:aBlock |
|
3228 ]. |
|
3229 ^ aBlock value |
|
3230 ! |
|
3231 |
|
3232 first |
|
3233 "returns the first selected item or nil |
|
3234 " |
|
3235 ^ self at:1 |
|
3236 ! |
|
3237 |
|
3238 last |
|
3239 "returns the last selected item or nil |
|
3240 " |
|
3241 ^ selection notNil ifTrue:[selection last] ifFalse:[nil] |
|
3242 ! |
|
3243 |
|
3244 selectedItem |
|
3245 "returns the single selected item or nil (size ~~ 1 nil is returned) |
|
3246 " |
|
3247 ^ selection size == 1 ifTrue:[selection at:1] ifFalse:[nil] |
|
3248 ! |
|
3249 |
|
3250 selectedSuperItems |
|
3251 "returs the list of selected superItems; items selected |
|
3252 but not contained in another selected item. |
|
3253 " |
|
3254 ^ selectedSuperItems |
|
3255 ! |
|
3256 |
|
3257 size |
|
3258 "returns the number of items selected |
|
3259 " |
|
3260 ^ selection size |
|
3261 ! ! |
|
3262 |
|
3263 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection adding & removing'! |
|
3264 |
|
3265 add:item |
|
3266 "add an item to the current selection |
|
3267 " |
|
3268 |newSelect| |
|
3269 |
|
3270 item isNil ifTrue:[^ item]. |
|
3271 |
|
3272 lockSema critical:[ |
|
3273 selection isNil ifTrue:[ |
|
3274 newSelect := Array with:item. |
|
3275 ] ifFalse:[ |
|
3276 (self includes:item) ifFalse:[ |
|
3277 newSelect := selection copyWith:item |
|
3278 ] |
|
3279 ]. |
|
3280 |
|
3281 newSelect size ~~ selection size ifTrue:[ |
|
3282 item makeVisible. |
|
3283 self value:newSelect |
|
3284 ] |
|
3285 ]. |
|
3286 ^ item |
|
3287 ! |
|
3288 |
|
3289 addAll:aCollectionOfItems |
|
3290 "add a collection of items to the current selection |
|
3291 " |
|
3292 |newSelect| |
|
3293 |
|
3294 aCollectionOfItems size == 0 ifTrue:[ ^ aCollectionOfItems ]. |
|
3295 |
|
3296 lockSema critical:[ |
|
3297 selection isNil ifTrue:[ |
|
3298 newSelect := Array withAll:aCollectionOfItems. |
|
3299 ] ifFalse:[ |
|
3300 newSelect := OrderedCollection withAll:selection. |
|
3301 |
|
3302 aCollectionOfItems do:[:el| |
|
3303 (selection includesIdentical:el) ifFalse:[newSelect add:el] |
|
3304 ]. |
|
3305 ]. |
|
3306 self value:newSelect. |
|
3307 ]. |
|
3308 ^ aCollectionOfItems |
|
3309 ! |
|
3310 |
|
3311 deselect |
|
3312 "clear the selection |
|
3313 " |
|
3314 self value:nil. |
|
3315 ! |
|
3316 |
|
3317 remove:item |
|
3318 "remove the item from the current selection |
|
3319 " |
|
3320 |newSelect| |
|
3321 |
|
3322 item isNil ifTrue:[^ nil]. |
|
3323 |
|
3324 lockSema critical:[ |
|
3325 (selection notNil and:[selection includesIdentical:item]) ifTrue:[ |
|
3326 selection size == 1 ifTrue:[ newSelect := nil ] |
|
3327 ifFalse:[ newSelect := selection copyWithout:item ]. |
|
3328 |
|
3329 self value:newSelect |
|
3330 ]. |
|
3331 ]. |
|
3332 ^ item |
|
3333 ! |
|
3334 |
|
3335 removeAll |
|
3336 "clear the selection |
|
3337 " |
|
3338 self deselect. |
|
3339 ! |
|
3340 |
|
3341 removeAll:loItems |
|
3342 "remove all items of the collection from the current selection |
|
3343 " |
|
3344 |newSelect| |
|
3345 |
|
3346 selection isNil ifTrue:[ ^ loItems ]. |
|
3347 loItems size == 0 ifTrue:[ ^ loItems ]. |
|
3348 |
|
3349 lockSema critical:[ |
|
3350 selection notNil ifTrue:[ |
|
3351 newSelect := selection select:[:el| (loItems includesIdentical:el) not ]. |
|
3352 self value:newSelect. |
|
3353 ] |
|
3354 ]. |
|
3355 ^ loItems |
|
3356 ! |
|
3357 |
|
3358 selectAll |
|
3359 "select all items |
|
3360 " |
|
3361 |root newSelection| |
|
3362 |
|
3363 root := listOfItems root. |
|
3364 |
|
3365 root isNil ifTrue:[ |
|
3366 newSelection := nil |
|
3367 ] ifFalse:[ |
|
3368 newSelection := OrderedCollection new. |
|
3369 root recursiveDo:[:el| newSelection add:el ]. |
|
3370 ]. |
|
3371 self value:newSelection. |
|
3372 ! |
|
3373 |
|
3374 selectItem:anItem |
|
3375 "set the current selection to the item |
|
3376 " |
|
3377 self value:anItem |
|
3378 ! |
|
3379 |
|
3380 selectRootItem |
|
3381 "set the current selection to the root item |
|
3382 " |
|
3383 self value:(self rootItem). |
|
3384 ! |
|
3385 |
|
3386 selectedItem:anItem |
|
3387 "set the current selection to the item |
|
3388 " |
|
3389 self selectItem:anItem. |
|
3390 ! |
|
3391 |
|
3392 toggleSelectItem:anItem |
|
3393 "toggle selection-state of the item; add or remove the item from the |
|
3394 current selection. |
|
3395 " |
|
3396 anItem notNil ifTrue:[ |
|
3397 (self includes:anItem) ifTrue:[self remove:anItem] |
|
3398 ifFalse:[self add:anItem] |
|
3399 ]. |
|
3400 ^ anItem |
|
3401 ! ! |
|
3402 |
|
3403 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection enumerating'! |
|
3404 |
|
3405 collect:aBlock |
|
3406 "for each element in the selection, evaluate the argument, aBlock |
|
3407 and return a new collection with the results |
|
3408 " |
|
3409 |res| |
|
3410 |
|
3411 res := OrderedCollection new. |
|
3412 self do:[:el| res add:(aBlock value:el)]. |
|
3413 ^ res |
|
3414 ! |
|
3415 |
|
3416 do:aOneArgBlock |
|
3417 "evaluate the argument, aBlock for each item in the selection |
|
3418 " |
|
3419 |cashedSelection| |
|
3420 |
|
3421 cashedSelection := selection. |
|
3422 cashedSelection isNil ifTrue:[^ nil]. |
|
3423 ^ cashedSelection do:aOneArgBlock |
|
3424 ! |
|
3425 |
|
3426 from:start do:aOneArgBlock |
|
3427 "evaluate the argument, aBlock for the items starting at index start |
|
3428 " |
|
3429 |cashedSelection| |
|
3430 |
|
3431 cashedSelection := selection. |
|
3432 cashedSelection isNil ifTrue:[^ nil]. |
|
3433 ^ cashedSelection from:start do:aOneArgBlock |
|
3434 ! |
|
3435 |
|
3436 from:start to:stop do:aOneArgBlock |
|
3437 "evaluate the argument, aBlock for the items with index start to |
|
3438 stop in the selection. |
|
3439 " |
|
3440 |cashedSelection| |
|
3441 |
|
3442 cashedSelection := selection. |
|
3443 cashedSelection isNil ifTrue:[^ nil]. |
|
3444 ^ cashedSelection from:start to:stop do:aOneArgBlock |
|
3445 ! |
|
3446 |
|
3447 reverseDo:aOneArgBlock |
|
3448 "evaluate the argument, aBlock for each item in the selection |
|
3449 " |
|
3450 |cashedSelection| |
|
3451 |
|
3452 cashedSelection := selection. |
|
3453 cashedSelection isNil ifTrue:[^ nil]. |
|
3454 ^ cashedSelection reverseDo:aOneArgBlock |
|
3455 ! |
|
3456 |
|
3457 select:aBlock |
|
3458 "return a new collection with all elements from the selection, for which |
|
3459 the argument aBlock evaluates to true. |
|
3460 " |
|
3461 |res| |
|
3462 |
|
3463 res := OrderedCollection new. |
|
3464 self do:[:el| (aBlock value:el) ifTrue:[res add:el] ]. |
|
3465 ^ res |
|
3466 ! ! |
|
3467 |
|
3468 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection protocol'! |
|
3469 |
|
3470 changed:aParameter with:oldSelection |
|
3471 "update the visibility staus of the current selection |
|
3472 " |
|
3473 |unselected rootView rootItem selSize| |
|
3474 |
|
3475 selSize := selection size. |
|
3476 |
|
3477 selSize == 0 ifTrue:[ |
|
3478 selectedSuperItems := #(). |
|
3479 ] ifFalse:[ |
|
3480 selSize == 1 ifTrue:[ |
|
3481 selectedSuperItems := Array with:(selection at:1). |
|
3482 ] ifFalse:[ |
|
3483 rootItem := listOfItems root. |
|
3484 |
|
3485 (selection includesIdentical:rootItem) ifTrue:[ |
|
3486 selectedSuperItems := Array with:rootItem. |
|
3487 ] ifFalse:[ |
|
3488 selectedSuperItems := OrderedCollection new:selSize. |
|
3489 |
|
3490 selection do:[:anItem| |
|
3491 anItem parentsDetect:[:el| selection includesIdentical:el ] |
|
3492 ifNone:[ selectedSuperItems add:anItem ]. |
|
3493 ]. |
|
3494 ] |
|
3495 ] |
|
3496 ]. |
|
3497 |
|
3498 ( hiddenLevel == 0 |
|
3499 and:[(rootView := listOfItems rootView) notNil |
|
3500 and:[rootView shown]] |
|
3501 ) ifTrue:[ |
|
3502 selSize == 0 ifTrue:[ |
|
3503 "/ must redraw the old selection unselected |
|
3504 self redrawUnselected:oldSelection andLock:false |
|
3505 ] ifFalse:[ |
|
3506 self invalidateSelection. |
|
3507 |
|
3508 oldSelection size ~~ 0 ifTrue:[ |
|
3509 "/ must redraw all elements no longer in the selection |
|
3510 unselected := oldSelection select:[:el| (selection includesIdentical:el) not ]. |
|
3511 self redrawUnselected:unselected andLock:false. |
|
3512 ] |
|
3513 ] |
|
3514 ]. |
|
3515 super changed:aParameter with:oldSelection. |
|
3516 ! |
|
3517 |
|
3518 setValue:aNewSelection |
|
3519 "set the selection without notifying |
|
3520 " |
|
3521 |newSelect idx| |
|
3522 |
|
3523 newSelect := nil. |
|
3524 |
|
3525 aNewSelection notNil ifTrue:[ |
|
3526 lockSema critical:[ |
|
3527 aNewSelection isCollection ifFalse:[ |
|
3528 (selection size == 1 and:[selection first == aNewSelection]) ifTrue:[ |
|
3529 newSelect := selection |
|
3530 ] ifFalse:[ |
|
3531 newSelect := Array with:aNewSelection. |
|
3532 ] |
|
3533 ] ifTrue:[ |
|
3534 aNewSelection notEmpty ifTrue:[ |
|
3535 aNewSelection size ~~ selection size ifTrue:[ |
|
3536 newSelect := aNewSelection copy. |
|
3537 ] ifFalse:[ |
|
3538 idx := selection findFirst:[:el| (aNewSelection includesIdentical:el) not ]. |
|
3539 |
|
3540 idx ~~ 0 ifTrue:[newSelect := aNewSelection copy] |
|
3541 ifFalse:[newSelect := selection ]. |
|
3542 ] |
|
3543 ] |
|
3544 ] |
|
3545 ]. |
|
3546 ]. |
|
3547 newSelect ~~ selection ifTrue:[ |
|
3548 beforeSelectionChangedAction value. |
|
3549 selection := newSelect. |
|
3550 selection notNil ifTrue:[selection do:[:el| el makeVisible]] |
|
3551 ]. |
|
3552 ! |
|
3553 |
|
3554 triggerValue:aValue |
|
3555 "set my value & send change notifications to my dependents. |
|
3556 Send the change message even if the value didn't change. |
|
3557 " |
|
3558 |oldSelection| |
|
3559 |
|
3560 lockSema critical:[ |
|
3561 oldSelection := selection. |
|
3562 self setValue:aValue. |
|
3563 self changed:#value with:oldSelection |
|
3564 ] |
|
3565 ! |
|
3566 |
|
3567 value |
|
3568 "returns the current selection |
|
3569 " |
|
3570 ^ selection ? #() |
|
3571 ! |
|
3572 |
|
3573 value:aValue |
|
3574 "change the current selection and send change notifications to my |
|
3575 dependents if it changed. |
|
3576 " |
|
3577 |oldSelection| |
|
3578 |
|
3579 lockSema critical:[ |
|
3580 oldSelection := selection. |
|
3581 self setValue:aValue. |
|
3582 |
|
3583 oldSelection == selection ifFalse:[ |
|
3584 self changed:#value with:oldSelection |
|
3585 ] |
|
3586 ]. |
|
3587 ! ! |
|
3588 |
|
3589 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection searching'! |
|
3590 |
|
3591 detect:aBlock |
|
3592 "evaluate the argument, aBlock for each item in the selection until |
|
3593 the block returns true; in this case return the element which caused |
|
3594 the true evaluation. |
|
3595 If none of the evaluations returns true, an error is raised |
|
3596 " |
|
3597 ^ self detect:aBlock ifNone:[self errorNotFound] |
|
3598 ! |
|
3599 |
|
3600 detect:aBlock ifNone:exceptionBlock |
|
3601 "evaluate the argument, aBlock for each item in the selection until the |
|
3602 block returns true; in this case return the element which caused the |
|
3603 true evaluation. |
|
3604 If none of the evaluations returns true, the result of the evaluation |
|
3605 of the exceptionBlock is returned |
|
3606 " |
|
3607 |cashedSelection| |
|
3608 |
|
3609 cashedSelection := selection. |
|
3610 cashedSelection isNil ifTrue:[ ^ exceptionBlock value ]. |
|
3611 ^ cashedSelection detect:aBlock ifNone:exceptionBlock |
|
3612 ! |
|
3613 |
|
3614 detectLast:aBlock |
|
3615 "evaluate the argument, aBlock for each item in the selection until |
|
3616 the block returns true; in this case return the element which caused |
|
3617 the true evaluation. The items are processed in reverse order. |
|
3618 If none of the evaluations returns true, an error is raised |
|
3619 " |
|
3620 ^ self detectLast:aBlock ifNone:[self errorNotFound] |
|
3621 ! |
|
3622 |
|
3623 detectLast:aBlock ifNone:exceptionBlock |
|
3624 "evaluate the argument, aBlock for each item in the selection until |
|
3625 the block returns true; in this case return the element which caused |
|
3626 the true evaluation. The items are processed in reverse order. |
|
3627 If none of the evaluations returns true, the result of the evaluation |
|
3628 of the exceptionBlock is returned |
|
3629 " |
|
3630 |cashedSelection| |
|
3631 |
|
3632 cashedSelection := selection. |
|
3633 cashedSelection isNil ifTrue:[ ^ exceptionBlock value ]. |
|
3634 ^ cashedSelection detectLast:aBlock ifNone:exceptionBlock |
|
3635 ! ! |
|
3636 |
|
3637 !ViewTreeInspectorApplication::ViewTreeModel methodsFor:'selection testing'! |
|
3638 |
|
3639 includes:anItem |
|
3640 "returns true if the item is in the current selection |
|
3641 " |
|
3642 |cashedSelection| |
|
3643 |
|
3644 cashedSelection := selection. |
|
3645 cashedSelection isNil ifTrue:[^ false]. |
|
3646 ^ cashedSelection includesIdentical:anItem |
|
3647 ! |
|
3648 |
|
3649 includesAll:aCollection |
|
3650 "return true, if all items of the collection are included in the current selection |
|
3651 " |
|
3652 |cashedSelection| |
|
3653 |
|
3654 aCollection size ~~ 0 ifTrue:[ |
|
3655 cashedSelection := selection. |
|
3656 cashedSelection isNil ifTrue:[ ^ false ]. |
|
3657 |
|
3658 aCollection do:[:el| |
|
3659 (cashedSelection includesIdentical:el) ifFalse:[^ false] |
|
3660 ] |
|
3661 ]. |
|
3662 ^ true |
|
3663 ! |
|
3664 |
|
3665 includesAny:aCollection |
|
3666 "return true, if the any item of the collection is in the current selection |
|
3667 " |
|
3668 |cashedSelection| |
|
3669 |
|
3670 aCollection notNil ifTrue:[ |
|
3671 cashedSelection := selection. |
|
3672 |
|
3673 cashedSelection notNil ifTrue:[ |
|
3674 aCollection do:[:el| |
|
3675 (cashedSelection includesIdentical:el) ifTrue:[^ true] |
|
3676 ] |
|
3677 ] |
|
3678 ]. |
|
3679 ^ false |
|
3680 ! |
|
3681 |
|
3682 includesIdentical:anItem |
|
3683 "returns true if the item is in the current selection |
|
3684 " |
|
3685 ^ self includes:anItem |
|
3686 ! |
|
3687 |
|
3688 isEmpty |
|
3689 "returns true if the current selection is empty |
|
3690 " |
|
3691 ^ selection size == 0 |
|
3692 ! |
|
3693 |
|
3694 isSelected:anItem |
|
3695 "returns true if the item is in the current selection |
|
3696 " |
|
3697 ^ self includes:anItem |
|
3698 ! |
|
3699 |
|
3700 notEmpty |
|
3701 "returns true if the current selection is not empty |
|
3702 " |
|
3703 ^ selection size ~~ 0 |
|
3704 ! ! |
|
3705 |
|
3706 !ViewTreeInspectorApplication::ViewTreeModel::ItemList class methodsFor:'documentation'! |
|
3707 |
|
3708 documentation |
|
3709 " |
|
3710 Kind of HierarchicalList class which contains all the visible |
|
3711 ViewTreeItem's and the root, the anchor of the hierarchical list. |
|
3712 |
|
3713 [Instance variables:] |
|
3714 treeModel <ViewTreeModel> all events are delegated to |
|
3715 eventHook <BlockValue> save and resore the pre/post -EventHook |
|
3716 |
|
3717 |
|
3718 [author:] |
|
3719 Claus Atzkern |
|
3720 |
|
3721 [see also:] |
|
3722 HierarchicalList |
|
3723 ViewTreeModel |
|
3724 ViewTreeItem |
|
3725 " |
|
3726 ! ! |
|
3727 |
|
3728 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing'! |
|
3729 |
|
3730 root:theRoot |
|
3731 "set the root item; delegate events to my treeModel |
|
3732 " |
|
3733 |rootView| |
|
3734 |
|
3735 theRoot == root ifTrue:[^ self]. |
|
3736 |
|
3737 rootView := self rootView. |
|
3738 super root:theRoot. |
|
3739 |
|
3740 rootView notNil ifTrue:[ |wgrp| |
|
3741 wgrp := rootView windowGroup. |
|
3742 |
|
3743 wgrp notNil ifTrue:[ |
|
3744 wgrp removePreEventHook:treeModel. |
|
3745 wgrp removePostEventHook:self. |
|
3746 ]. |
|
3747 ]. |
|
3748 |
|
3749 super root:theRoot. |
|
3750 rootView := self rootView. |
|
3751 |
|
3752 rootView notNil ifTrue:[ |
|
3753 "must setup a task because there might not exist a windowGroup at the moment |
|
3754 " |
|
3755 [ |wgrp| |
|
3756 |
|
3757 [rootView == self rootView] whileTrue:[ |
|
3758 wgrp := rootView windowGroup. |
|
3759 wgrp notNil ifTrue:[ |
|
3760 rootView := nil. |
|
3761 wgrp addPreEventHook:treeModel. |
|
3762 wgrp addPostEventHook:self. |
|
3763 ] ifFalse:[ |
|
3764 Delay waitForMilliseconds:100. |
|
3765 ]. |
|
3766 ]. |
|
3767 |
|
3768 ] forkAt:(Processor userSchedulingPriority + 2). |
|
3769 ]. |
|
3770 treeModel notNil ifTrue:[ |
|
3771 treeModel targetWidgetChanged. |
|
3772 ]. |
|
3773 |
|
3774 ^ root. |
|
3775 ! |
|
3776 |
|
3777 rootView |
|
3778 "returns the widget assigned to the root or nil |
|
3779 " |
|
3780 ^ root notNil ifTrue:[root widget] ifFalse:[nil] |
|
3781 ! |
|
3782 |
|
3783 treeModel |
|
3784 "returne the treeModel, a ViewTreeModel |
|
3785 " |
|
3786 ^ treeModel |
|
3787 ! ! |
|
3788 |
|
3789 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'accessing look'! |
|
3790 |
|
3791 additionalLabelForItem:anItem |
|
3792 "answer the additional lable for an item or nil" |
|
3793 |
|
3794 |applClass| |
|
3795 |
|
3796 showWidgetNames == true ifTrue:[ |
|
3797 ^ '[', anItem widget name, ']' |
|
3798 ]. |
|
3799 |
|
3800 anItem isApplicationClass ifTrue:[ |
|
3801 applClass := anItem applicationClass. |
|
3802 |
|
3803 applClass notNil ifTrue:[ |
|
3804 ^ ('[', applClass name, ']') |
|
3805 ]. |
|
3806 ]. |
|
3807 ^ nil |
|
3808 ! |
|
3809 |
|
3810 showWidgetNames |
|
3811 "answer true if the additional text is the widget name |
|
3812 otherwise the name of the application" |
|
3813 |
|
3814 ^ showWidgetNames ? false |
|
3815 ! |
|
3816 |
|
3817 showWidgetNames:aBoolean |
|
3818 "set true if the additional text is the widget name |
|
3819 otherwise the name of the application" |
|
3820 |
|
3821 self showWidgetNames == aBoolean ifFalse:[ |
|
3822 showWidgetNames := aBoolean. |
|
3823 |
|
3824 root notNil ifTrue:[ |
|
3825 root recursiveAdditionalNameBehaviourChanged. |
|
3826 self changed. |
|
3827 ]. |
|
3828 ]. |
|
3829 ! ! |
|
3830 |
|
3831 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'event processing'! |
|
3832 |
|
3833 processEvent:anEvent |
|
3834 "post process event |
|
3835 " |
|
3836 ^ treeModel isInTestMode not |
|
3837 ! ! |
|
3838 |
|
3839 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'instance creation'! |
|
3840 |
|
3841 on:aModel |
|
3842 "set the model, a ViewTreeModel |
|
3843 " |
|
3844 treeModel := aModel. |
|
3845 showRoot := true. |
|
3846 showWidgetNames := false. |
|
3847 ! ! |
|
3848 |
|
3849 !ViewTreeInspectorApplication::ViewTreeModel::ItemList methodsFor:'searching'! |
|
3850 |
|
3851 detectItemRespondsToView:aView |
|
3852 "returns the bottom-most item which contains the view |
|
3853 " |
|
3854 |view item topView| |
|
3855 |
|
3856 root notNil ifTrue:[ |
|
3857 view := aView. |
|
3858 topView := root widget. |
|
3859 |
|
3860 [ view notNil ] whileTrue:[ |
|
3861 topView == view ifTrue:[^ root]. |
|
3862 item := root recursiveDetect:[:el| el widget == view ]. |
|
3863 item notNil ifTrue:[^ item]. |
|
3864 view := view superView |
|
3865 ] |
|
3866 ]. |
|
3867 ^ nil |
|
3868 ! |
|
3869 |
|
3870 recursiveDetect:aOneOrgBlock |
|
3871 "recursive find the first child, for which evaluation |
|
3872 of the block returns true; if none nil is returned |
|
3873 " |
|
3874 root notNil ifTrue:[ |
|
3875 (aOneOrgBlock value:root) ifTrue:[ ^ root ]. |
|
3876 ^ root recursiveDetect:aOneOrgBlock |
|
3877 ]. |
|
3878 ^ nil |
|
3879 ! ! |
|
3880 |
|
3881 !ViewTreeInspectorApplication class methodsFor:'documentation'! |
|
3882 |
|
3883 version |
|
3884 ^ '$Header$' |
|
3885 ! |
|
3886 |
|
3887 version_CVS |
|
3888 ^ '$Header$' |
|
3889 ! ! |
|
3890 |
|
3891 ViewTreeInspectorApplication initialize! |
|
3892 ViewTreeInspectorApplication::ViewTreeItem initialize! |