update
authorClaus Gittinger <cg@exept.de>
Fri, 01 Jul 2011 16:21:19 +0200
changeset 10023 68c1f1618b7d
parent 10022 a51c7fd32748
child 10024 b273c6fd3606
update
Tools__NewSystemBrowserCodeView.st
--- a/Tools__NewSystemBrowserCodeView.st	Fri Jul 01 16:19:38 2011 +0200
+++ b/Tools__NewSystemBrowserCodeView.st	Fri Jul 01 16:21:19 2011 +0200
@@ -1,4 +1,15 @@
-"{ Package: 'cvut:stx/goodies/libtool3' }"
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+"{ Package: 'stx:libtool' }"
 
 "{ NameSpace: Tools }"
 
@@ -10,6 +21,21 @@
 	category:'Interface-Browsers-New'
 !
 
+!NewSystemBrowserCodeView class methodsFor:'documentation'!
+
+copyright
+"
+ COPYRIGHT (c) 2006 by eXept Software AG
+	      All Rights Reserved
+
+ This software is furnished under a license and may be used
+ only in accordance with the terms of that license and with the
+ inclusion of the above copyright notice.   This software may not
+ be provided or otherwise made available to, or used by, any
+ other person.  No title to or ownership of the software is
+ hereby transferred.
+"
+! !
 
 !NewSystemBrowserCodeView class methodsFor:'initialization'!
 
@@ -17,14 +43,17 @@
     "
         self initialize
     "
-
-    Display keyboardMap 
-        bindValue:#ImplementorsOfIt to:#Cmdm;
-        bindValue:#SendersOfIt to:#Cmdn;
-        bindValue:#GoBack to:#CmdBackSpace
+    "
+    Smalltalk addStartBlock:
+        [Display keyboardMap 
+            bindValue:#ImplementorsOfIt to:#Cmdm;
+            bindValue:#SendersOfIt to:#Cmdn;
+            bindValue:#GoBack to:#CmdBackSpace]
+    "
 
     "Created: / 25-12-2007 / 19:58:53 / janfrog"
     "Modified: / 27-02-2008 / 12:16:10 / janfrog"
+    "Modified: / 15-04-2010 / 16:40:18 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !NewSystemBrowserCodeView class methodsFor:'menu specs'!
@@ -192,12 +221,13 @@
         An empty interval check based on Claus suggestion
         (email Fri, 10 Oct 2008 16:10:25 +0200)
     "
-    anInterval isEmpty ifTrue:[^self].
+    anInterval isEmpty ifTrue:[^nil].
 
     ^self findNodeIn: self parseTree forInterval: anInterval
 
     "Created: / 19-02-2008 / 09:44:50 / janfrog"
     "Modified: / 18-10-2008 / 16:47:53 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Modified: / 01-09-2009 / 22:45:28 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 findNodeIn:tree forInterval:interval 
@@ -244,7 +274,7 @@
     |selectedText|
 
     ^ (selectedText := self selectionAsString) isNilOrEmptyCollection 
-        ifFalse:[ ^ (SystemBrowser extractSelectorFrom:selectedText) asSymbol ]
+        ifFalse:[ (SystemBrowser extractSelectorFrom:selectedText) asSymbol ]
         ifTrue:[
             selectedNode ifNil:[ self highlightNodeAtCursor ].
             (selectedNode notNil and:[ selectedNode isMessage ]) ifTrue:[
@@ -297,24 +327,21 @@
     "Modified: / 19-02-2008 / 09:15:09 / janfrog"
 !
 
-buttonPress:button x:x y:y 
-    |node|
+buttonPress: button x: x y: y 
+    | node |
 
-    (self sensor ctrlDown and:[ (node := self selectedNode) notNil ]) ifTrue:[
-        button = 1 ifTrue:[
-            ^ self openMenu:(node redButtonMenuInCodeView:self)
-        ].
-        button = #paste ifTrue:[
-            ^ self openMenu:(node yellowButtonMenuInCodeView:self)
-        ].
-        button = 2 ifTrue:[
-            ^ self openMenu:(node blueButtonMenuInCodeView:self)
-        ]
-    ].
+    (self sensor ctrlDown and: [ (node := self selectedNode) notNil ]) 
+        ifTrue: 
+            [ button = 1 
+                ifTrue: [ ^ self openMenu: (node leftClickMenuInCodeView: self) ].
+            button = #paste 
+                ifTrue: [ ^ self openMenu: (node middleClickMenuInCodeView: self) ].
+            button = 2 
+                ifTrue: [ ^ self openMenu: (node rightClickMenuInCodeView: self) ] ].
     super 
-        buttonPress:button
-        x:x
-        y:y
+        buttonPress: button
+        x: x
+        y: y
 
     "Created: / 26-12-2007 / 11:39:50 / janfrog"
     "Modified: / 21-02-2008 / 09:17:29 / janfrog"
@@ -371,6 +398,22 @@
 
 !NewSystemBrowserCodeView methodsFor:'menu'!
 
+browseClassesMenu: classes 
+    | menu|
+
+    menu := Menu new.
+    classes do:
+        [:cls|
+        menu addItem:(MenuItem 
+                        label: ('Browse ' , cls fullName asText allBold)
+                        value:[self browseClass: cls])].
+
+    ^ menu
+
+    "Modified: / 19-10-2008 / 08:16:50 / Jan Vrany <vranyj1@fel.cvut.cz>"
+    "Created: / 01-09-2009 / 09:41:59 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 editMenu
 
     | editMenu superEditMenu moreMenu moreMenuItem |
@@ -503,6 +546,22 @@
     "Created: / 26-12-2007 / 12:33:19 / janfrog"
 !
 
+browseClass: class
+
+    self browser ifNil: [^NewSystemBrowser browseClass:class].
+    (UserPreferences current alwaysOpenNewTabWhenCtrlClick or:[self browser navigationState modified])  
+        ifTrue:
+            [self browser 
+                spawnClassBrowserFor:(Array with: class)
+                in:#newBuffer]
+        ifFalse:
+            [self browser 
+                switchToClass: class].
+
+    "Modified: / 19-02-2008 / 10:15:17 / janfrog"
+    "Created: / 01-09-2009 / 08:52:24 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
 browseImplementorsOfIt
 
     | selector implementors |
@@ -607,12 +666,61 @@
     "Created: / 18-02-2008 / 21:04:32 / janfrog"
 !
 
+leftClickMenuForMessageNode: messageNode 
+    ^ self messageNodeImplementorsMenu: messageNode
+
+    "Modified: / 18-02-2008 / 21:05:47 / janfrog"
+!
+
+leftClickMenuForVariableNode: varNode
+
+    | environment classes |
+    self browser ifNil:[^nil].
+    environment := self browser theSingleSelectedMethod mclass environment.
+    classes := OrderedCollection new.
+    [ environment notNil ] whileTrue:
+        [| cls |
+        cls := environment at: varNode name asSymbol.
+        cls ifNotNil:[classes add: cls].
+        environment :=
+            environment = Smalltalk 
+                ifTrue:[environment := nil]
+                ifFalse:[environment environment]].
+    ^classes isEmpty 
+        ifTrue:[self browseClassesMenu: classes ]
+        ifFalse:[self variableNodeMenuContext: varNode]
+
+    "Modified: / 18-02-2008 / 21:05:47 / janfrog"
+    "Created: / 01-09-2009 / 08:41:37 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+    "Modified: / 01-09-2009 / 09:46:10 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+middleClickMenuForMessageNode: messageNode 
+    ^ self messageNodeSendersMenu: messageNode
+
+    "Created: / 18-02-2008 / 19:08:50 / janfrog"
+    "Modified: / 18-02-2008 / 21:05:56 / janfrog"
+!
+
 redButtonMenuForMessageNode:messageNode 
     ^ self messageNodeImplementorsMenu:messageNode
 
     "Modified: / 18-02-2008 / 21:05:47 / janfrog"
 !
 
+rightClickMenuForMessageNode: messageNode 
+    ^ self messageNodeContextMenu: messageNode
+
+    "Created: / 18-02-2008 / 19:12:56 / janfrog"
+    "Modified: / 18-02-2008 / 21:05:36 / janfrog"
+!
+
+rightClickMenuForVariableNode: variableNode 
+    ^ self variableNodeMenuContext: variableNode
+
+    "Created: / 18-02-2008 / 21:04:32 / janfrog"
+!
+
 yellowButtonMenuForMessageNode:messageNode 
     ^ self messageNodeSendersMenu:messageNode
 
@@ -646,27 +754,17 @@
 !NewSystemBrowserCodeView methodsFor:'private - highlighting'!
 
 highlightClear
-    self list ifNil:[^self].
-    self list do:
-            [:line | 
-            line isText ifTrue: 
-                [ line emphasisAllRemove: self highlightEmphasis]]
+    self list ifNil:[ ^ self ].
+    self list do:[:line | 
+        line isText ifTrue:[
+            line emphasisAllRemove:self selectorEmphasis
+        ]
+    ]
 
     "Created: / 25-12-2007 / 23:26:27 / janfrog"
     "Modified: / 26-12-2007 / 12:28:05 / janfrog"
 !
 
-highlightEmphasis
-    ^ highlightEmphasis ifNil:
-        [highlightEmphasis := Array 
-                                with:#underline
-                                with:#bold
-                                "with:#underlineColor -> Color blue"]
-
-    "Created: / 25-12-2007 / 22:57:23 / janfrog"
-    "Modified: / 26-12-2007 / 11:16:14 / janfrog"
-!
-
 highlightFrom: start to: end 
     "Remove underlined emphasis"
 
@@ -681,33 +779,27 @@
     "Created: / 25-12-2007 / 22:56:28 / janfrog"
 !
 
-highlightFromLine: startLine col: startCol toLine: endLine col: endCol
-
-    self list keysAndValuesDo:
-        [:lineNo :line|
-        |start end|
-        line isText ifTrue:
-            [line emphasisAllRemove: self highlightEmphasis.
-            self highlightLine: lineNo fromLine: startLine col: endLine toLine: startCol col: endCol.
-            self redrawLine: lineNo]].
-
-    "Created: / 25-12-2007 / 23:10:57 / janfrog"
-!
+highlightLine:lineNo fromLine:startLine col:endLine toLine:startCol col:endCol emphasis: em 
+    |line start end|
 
-highlightLine: lineNo fromLine: startLine col: endLine toLine: startCol col: endCol 
+    (lineNo between:startLine and:endLine) ifFalse:[
+        ^ self
+    ].
+    line := self listAt:lineNo.
+    start := lineNo = startLine ifTrue:[
+                startCol
+            ] ifFalse:[
+                line indexOfFirstNonBlankCharacter
+            ].
+    end := lineNo = endLine ifTrue:[
+                endCol
+            ] ifFalse:[ line size ].
+    line 
+        emphasisFrom:start
+        to:end
+        add: em
 
-    | line start end |
-    (lineNo between:startLine and: endLine) ifFalse:[^self].
-    line := self listAt: lineNo.
-    start := lineNo = startLine 
-                ifTrue:[startCol]
-                ifFalse:[line indexOfSeparator].
-    end := lineNo = endLine
-                ifTrue:[endCol]
-                ifFalse:[line size].
-    line emphasisFrom: start to: end add: self highlightEmphasis
-
-    "Created: / 25-12-2007 / 23:30:32 / janfrog"
+    "Created: / 25-06-2010 / 13:59:17 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 !
 
 highlightNode:node 
@@ -775,6 +867,26 @@
             [self highlightLine: lineNo fromLine: startLine col: endLine toLine: startCol col: endCol]].
 
     "Created: / 25-12-2007 / 23:35:07 / janfrog"
+!
+
+highlightWithoutClearFromLine: startLine col: startCol toLine: endLine col: endCol emphasis: em
+
+    self list keysAndValuesDo:
+        [:lineNo :line|
+        |start end|
+        line isText ifTrue:
+            [self highlightLine: lineNo fromLine: startLine col: endLine toLine: startCol col: endCol emphasis: em]].
+
+    "Created: / 25-06-2010 / 13:58:32 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectorEmphasis
+    ^ highlightEmphasis 
+        ifNil:[ highlightEmphasis := Array with:#underline with:#bold ]
+
+    "Created: / 25-12-2007 / 22:57:23 / janfrog"
+    "Modified: / 26-12-2007 / 11:16:14 / janfrog"
+    "Modified: / 01-09-2009 / 22:29:20 / Jan Vrany <jan.vrany@fit.cvut.cz>"
 ! !
 
 !NewSystemBrowserCodeView methodsFor:'private - highlighting - nodes'!
@@ -902,16 +1014,16 @@
 
 !NewSystemBrowserCodeView class methodsFor:'documentation'!
 
-version
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowserCodeView.st,v 1.5 2009-10-05 13:40:13 fm Exp $'
-!
-
 version_CVS
-    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowserCodeView.st,v 1.5 2009-10-05 13:40:13 fm Exp $'
+    ^ '$Header: /cvs/stx/stx/libtool/Tools__NewSystemBrowserCodeView.st,v 1.6 2011-07-01 14:21:19 cg Exp $'
 !
 
 version_CVS_jvrany
-    ^ 'Header: /opt/data/cvs/stx/goodies/libtool3/Tools__NewSystemBrowserCodeView.st,v 1.4 2008-02-27 13:45:41 vranyj1 Exp '
+    ^ '§Header: /opt/data/cvs/stx/goodies/libtool3/Tools__NewSystemBrowserCodeView.st,v 1.4 2008-02-27 13:45:41 vranyj1 Exp §'
+!
+
+version_SVN
+    ^ '§Id: Tools__NewSystemBrowserCodeView.st 7486 2009-10-26 22:06:24Z vranyj1 §'
 ! !
 
 NewSystemBrowserCodeView initialize!