"
 COPYRIGHT (c) 2008 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 }"

ApplicationModel subclass:#BreakpointBrowser
	instanceVariableNames:'updatingLabelShown breakpointList shownCopyOfBreakpointList
		selectionIndexHolder currentSortColumn currentSortIsReverse
		showHalts showAssertions showCodeBreakpoints
		showCodeBreakpointsFor showMethodBreakpoints codeView'
	classVariableNames:''
	poolDictionaries:''
	category:'Interface-Smalltalk-Breakpoints'
!

Object subclass:#BreakpointListEntry
	instanceVariableNames:'type arg className selector lineNumber info enabled'
	classVariableNames:''
	poolDictionaries:''
	privateIn:BreakpointBrowser
!

RBProgramNodeVisitor subclass:#MessageArgumentExtractor
	instanceVariableNames:'callBack selectorToSearch'
	classVariableNames:''
	poolDictionaries:''
	privateIn:BreakpointBrowser
!

!BreakpointBrowser class methodsFor:'documentation'!

copyright
"
 COPYRIGHT (c) 2008 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.
"
!

documentation
"
    tool to list breakpoints (breakPoint/halt/assert)

    [author:]
	cg (cg@FUSI)
"
! !

!BreakpointBrowser class methodsFor:'interface specs'!

windowSpec
    "This resource specification was automatically generated
     by the UIPainter of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the UIPainter may not be able to read the specification."

    "
     UIPainter new openOnClass:Tools::BreakpointBrowser andSelector:#windowSpec
     Tools::BreakpointBrowser new openInterface:#windowSpec
     Tools::BreakpointBrowser open
    "

    <resource: #canvas>

    ^
     #(FullSpec
	name: windowSpec
	window:
       (WindowSpec
	  label: 'Breakpoint Browser'
	  name: 'Breakpoint Browser'
	  min: (Point 10 10)
	  max: (Point 1024 768)
	  bounds: (Rectangle 0 0 680 691)
	  menu: mainMenu
	)
	component:
       (SpecCollection
	  collection: (
	   (MenuPanelSpec
	      name: 'ToolBar1'
	      layout: (LayoutFrame 0 0.0 0 0 0 1.0 40 0)
	      menu: toolBarMenu
	      textDefault: true
	    )
	   (VariableVerticalPanelSpec
	      name: 'VariableVerticalPanel1'
	      layout: (LayoutFrame 0 0 40 0 0 1 0 1)
	      snapMode: both
	      component:
	     (SpecCollection
		collection: (
		 (DataSetSpec
		    name: 'Table'
		    model: selectionIndexHolder
		    menu: itemMenu
		    hasHorizontalScrollBar: true
		    hasVerticalScrollBar: true
		    dataList: shownCopyOfBreakpointList
		    doubleClickSelector: itemDoubleClicked:
		    columnHolder: tableColumns
		  )
		 (TextEditorSpec
		    name: 'TextEditor1'
		    hasHorizontalScrollBar: true
		    hasVerticalScrollBar: true
		    hasKeyboardFocusInitially: false
		    viewClassName: 'CodeView'
		    postBuildCallback: postBuildCodeView:
		  )
		 )

	      )
	      handles: (Any 0.5 1.0)
	    )
	   (LabelSpec
	      label: 'Updating...'
	      name: 'Label1'
	      layout: (LayoutFrame 0 0 32 0 0 1 0 1)
	      visibilityChannel: updatingLabelShown
	      translateLabel: true
	    )
	   )

	)
      )
! !

!BreakpointBrowser class methodsFor:'menu specs'!

itemMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::BreakpointBrowser andSelector:#itemMenu
     (Menu new fromLiteralArrayEncoding:(Tools::BreakpointBrowser itemMenu)) startUp
    "

    <resource: #menu>

    ^
     #(Menu
	(
	 (MenuItem
	    label: 'Browse'
	    itemValue: browseItem
	    translateLabel: true
	  )
	 )
	nil
	nil
      )
!

mainMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::BreakpointBrowser andSelector:#mainMenu
     (Menu new fromLiteralArrayEncoding:(Tools::BreakpointBrowser mainMenu)) startUp
    "

    <resource: #menu>

    ^
     #(Menu
	(
	 (MenuItem
	    label: 'File'
	    translateLabel: true
	    submenu:
	   (Menu
	      (
	       (MenuItem
		  label: 'Exit'
		  itemValue: closeRequest
		  translateLabel: true
		)
	       )
	      nil
	      nil
	    )
	  )
	 (MenuItem
	    label: 'View'
	    translateLabel: true
	    submenu:
	   (Menu
	      (
	       (MenuItem
		  label: 'Update List'
		  itemValue: updateList
		  translateLabel: true
		)
	       (MenuItem
		  label: '-'
		)
	       (MenuItem
		  label: 'Assertions'
		  itemValue: showAssertions:
		  translateLabel: true
		  hideMenuOnActivated: false
		  indication: showAssertions
		)
	       (MenuItem
		  label: 'Halts'
		  itemValue: showHalts:
		  translateLabel: true
		  hideMenuOnActivated: false
		  indication: showHalts
		)
	       (MenuItem
		  label: '-'
		)
	       (MenuItem
		  label: 'Code Breakpoints'
		  itemValue: showCodeBreakpoints:
		  translateLabel: true
		  hideMenuOnActivated: false
		  indication: showCodeBreakpoints
		)
	       (MenuItem
		  enabled: showCodeBreakpoints
		  label: ' '
		  translateLabel: true
		  submenuChannel: codeBreakpointMenu
		)
	       (MenuItem
		  label: '-'
		)
	       (MenuItem
		  label: 'Method Breakpoints'
		  itemValue: showMethodBreakpoints:
		  translateLabel: true
		  hideMenuOnActivated: false
		  indication: showMethodBreakpoints
		)
	       )
	      nil
	      nil
	    )
	  )
	 (MenuItem
	    label: 'Enable'
	    translateLabel: true
	    submenu:
	   (Menu
	      (
	       (MenuItem
		  label: 'Assertions'
		  itemValue: enableAssertions:
		  translateLabel: true
		  indication: enableAssertions
		)
	       (MenuItem
		  label: 'Halts'
		  itemValue: enableHalts:
		  translateLabel: true
		  indication: enableHalts
		)
	       (MenuItem
		  label: '-'
		)
	       (MenuItem
		  label: 'Code Breakpoints'
		  translateLabel: true
		  submenuChannel: enabledCodeBreakpointMenu
		)
	       )
	      nil
	      nil
	    )
	  )
	 (MenuItem
	    label: 'Help'
	    translateLabel: true
	    startGroup: right
	    submenu:
	   (Menu
	      (
	       (MenuItem
		  label: 'Documentation'
		  itemValue: openDocumentation
		  translateLabel: true
		)
	       (MenuItem
		  label: '-'
		)
	       (MenuItem
		  label: 'About this Application...'
		  itemValue: openAboutThisApplication
		  translateLabel: true
		)
	       )
	      nil
	      nil
	    )
	  )
	 )
	nil
	nil
      )
!

toolBarMenu
    "This resource specification was automatically generated
     by the MenuEditor of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the MenuEditor may not be able to read the specification."

    "
     MenuEditor new openOnClass:Tools::BreakpointBrowser andSelector:#toolBarMenu
     (Menu new fromLiteralArrayEncoding:(Tools::BreakpointBrowser toolBarMenu)) startUp
    "

    <resource: #menu>

    ^
     #(Menu
	(
	 (MenuItem
	    label: 'Update List'
	    itemValue: updateList
	    translateLabel: true
	    isButton: true
	    labelImage: (ResourceRetriever XPToolbarIconLibrary reloadIcon)
	  )
	 (MenuItem
	    label: '-'
	  )
	 (MenuItem
	    enabled: hasSelectionHolder
	    label: 'Browse Selected Method'
	    itemValue: browseSelectedItem
	    translateLabel: true
	    isButton: true
	    labelImage: (ResourceRetriever XPToolbarIconLibrary startNewSystemBrowserIcon)
	  )
	 )
	nil
	nil
      )
! !

!BreakpointBrowser class methodsFor:'tableColumns specs'!

tableColumns
    "This resource specification was automatically generated
     by the DataSetBuilder of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the DataSetBuilder may not be able to read the specification."

    "
     DataSetBuilder new openOnClass:Tools::BreakpointBrowser andSelector:#tableColumns
    "

    <resource: #tableColumns>

    ^#(
      (DataSetColumnSpec
	 label: 'Type'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'type'
	 width: 60
	 model: type
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Arg'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'type'
	 width: 50
	 model: arg
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Class'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'className'
	 width: 150
	 model: className
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Method'
	 labelAlignment: left
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'selector'
	 width: 200
	 model: selector
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Line'
	 labelAlignment: left
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'lineNumber'
	 width: 35
	 model: lineNumber
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Info'
	 labelAlignment: left
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'info'
	 model: info
	 canSelect: false
       )
      )

!

tableColumns_v1
    "This resource specification was automatically generated
     by the DataSetBuilder of ST/X."

    "Do not manually edit this!! If it is corrupted,
     the DataSetBuilder may not be able to read the specification."

    "
     DataSetBuilder new openOnClass:Tools::BreakpointBrowser andSelector:#tableColumns
    "

    <resource: #tableColumns>

    ^#(
      (DataSetColumnSpec
	 label: 'Enabled'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 width: 50
	 editorType: CheckToggle
	 rendererType: CheckToggle
	 model: enabled
       )
      (DataSetColumnSpec
	 label: 'Type'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'type'
	 width: 60
	 model: type
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Arg'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'type'
	 width: 50
	 model: arg
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Class'
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'className'
	 width: 150
	 model: className
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Method'
	 labelAlignment: left
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'selector'
	 width: 200
	 model: selector
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Line'
	 labelAlignment: left
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'lineNumber'
	 width: 35
	 model: lineNumber
	 canSelect: false
       )
      (DataSetColumnSpec
	 label: 'Info'
	 labelAlignment: left
	 activeHelpKey: ''
	 activeHelpKeyForLabel: ''
	 labelButtonType: Button
	 labelActionSelector: sortBy:
	 labelActionArgument: 'info'
	 model: info
	 canSelect: false
       )
      )
! !

!BreakpointBrowser methodsFor:'accessing'!

aboutThisApplicationText
    |msg|

    msg := super aboutThisApplicationText.
    msg := msg , '\\Written by Claus Gittinger (cg@exept.de).'.
    ^msg withCRs.
!

breakpointListEntryAtIndex:idx
    ^ shownCopyOfBreakpointList at:idx ifAbsent:nil





!

selectedBreakpointListEntry
    ^ self breakpointListEntryAtIndex:(self selectionIndex).
!

selectionIndex
    ^ self selectionIndexHolder value
!

shownCopyOfBreakpointList
    shownCopyOfBreakpointList isNil ifTrue:[
	shownCopyOfBreakpointList := List new
    ].
    ^ shownCopyOfBreakpointList

    "Created: / 18-02-2007 / 12:53:01 / cg"
!

updatingLabelShown
    updatingLabelShown isNil ifTrue:[
	updatingLabelShown := true asValue
    ].
    ^ updatingLabelShown
! !

!BreakpointBrowser methodsFor:'aspects'!

enableAssertions
    ^ (Smalltalk at:#IgnoreAssertion ifAbsent:false) not
!

enableAssertions:aBoolean
    ^ Smalltalk at:#IgnoreAssertion put:aBoolean not
!

enableHalts
    ^ (Smalltalk at:#IgnoreHalt ifAbsent:false) not
!

enableHalts:aBoolean
    ^ Smalltalk at:#IgnoreHalt put:aBoolean not
!

hasSelectionHolder
    ^ BlockValue
	with:[:selIndex | selIndex notNil and:[selIndex ~~ 0]]
	argument:self selectionIndexHolder
!

selectionIndexHolder
    selectionIndexHolder isNil ifTrue:[
	selectionIndexHolder := nil asValue.
	selectionIndexHolder onChangeSend:#updateCode to:self
    ].
    ^ selectionIndexHolder

    "Created: / 22-10-2006 / 02:00:41 / cg"
!

showAssertions
    ^ showAssertions ? true
!

showAssertions:aBoolean
    showAssertions := aBoolean.
    self updateShownBreakpointList
!

showCodeBreakpoints
    ^ showCodeBreakpoints ? true
!

showCodeBreakpoints:aBoolean
    showCodeBreakpoints := aBoolean.
    self updateShownBreakpointList
!

showHalts
    ^ showHalts ? true
!

showHalts:aBoolean
    showHalts := aBoolean.
    self updateShownBreakpointList
!

showMethodBreakpoints
    ^ showMethodBreakpoints ? true
!

showMethodBreakpoints:aBoolean
    showMethodBreakpoints := aBoolean.
    self updateShownBreakpointList
! !

!BreakpointBrowser methodsFor:'change & update'!

delayedUpdate:something with:aParameter from:changedObject
"/    changedObject == toDoList ifTrue:[
"/        self updateShownToDoList.
"/        ^ self
"/    ].
!

filter
    |newList|

    newList := breakpointList.
    self showHalts ifFalse:[
	newList := newList reject:[:entry | entry isHalt].
    ].
    self showCodeBreakpoints ifFalse:[
	newList := newList reject:[:entry | entry isCodeBreakpoint].
    ] ifTrue:[
	newList := newList reject:[:entry |
				|flag|

				flag := (showCodeBreakpointsFor at:(entry arg ? '<nil>') ifAbsentPut:[true asValue]) value.
				entry isCodeBreakpoint
				and:[ flag not ]
			   ].
    ].
    self showMethodBreakpoints ifFalse:[
	newList := newList reject:[:entry | entry isMethodBreakpoint].
    ].
    self showAssertions ifFalse:[
	newList := newList reject:[:entry | entry isAssertion].
    ].
    shownCopyOfBreakpointList contents:newList.
!

update:something with:aParameter from:changedObject
    ^ super update:something with:aParameter from:changedObject

    "Created: / 18-02-2007 / 12:54:32 / cg"
!

updateBreakpointList
    |newShowCodeBreakpointsFor messages update |

    breakpointList removeAll.
    newShowCodeBreakpointsFor := Dictionary new.

    messages := #(
                    (#breakPoint:       #breakpoint)
                    (#breakPoint:info:  #breakpoint)
                    (#halt              #halt)
                    (#halt:             #halt)
                    (#assert:           #assertion)
                    (#assert:message:   #assertion)
                ).

    update := [:cls :mthd :sel |
        |entry type messagesSent|

        mthd isWrapped ifTrue:[
            mthd isBreakpointed ifTrue:[
                type := #trap
            ] ifFalse:[
                mthd isTraced ifTrue:[
                    type := #trace
                ] ifFalse:[
                    type := #probe
                ].
            ].
            entry := BreakpointListEntry new.
            entry
                type:#wrap
                arg:type
                className:cls name
                selector:sel
                lineNumber:nil
                info:nil
                enabled:true.
            breakpointList add:entry.
        ].

        messages pairsDo:[:bpSel :type|
            |tree extractor|

            "/ used to be (mthd sends:bpSel);
            "/ however, the sends requires an expensive parse of the methods source
            "/ to fetch all message selectors. This should be done only once,
            "/ and not for every selector we look for)
            (mthd referencesLiteral:bpSel) ifTrue:[
                messagesSent isNil ifTrue:[
                    messagesSent := mthd messagesSent.
                ].
                (messagesSent includesIdentical:bpSel) ifTrue:[
                    tree := mthd parseTree.
                    tree isNil ifTrue:[
                        entry := BreakpointListEntry new.
                        entry
                            type:type
                            arg:nil
                            className:cls name
                            selector:sel
                            lineNumber:nil
                            info:nil
                            enabled:true.
                        breakpointList add:entry.
                    ] ifFalse:[
                        extractor := MessageArgumentExtractor new.
                        extractor selectorToSearch:bpSel.
                        extractor callBack:[:lineNo :argument :infoMessage |
                            argument notNil ifTrue:[
                                newShowCodeBreakpointsFor
                                    at:argument
                                    put:(showCodeBreakpointsFor
                                            at:argument
                                            ifAbsent:[true asValue])
                            ].
                            entry := BreakpointListEntry new.
                            entry
                                type:type
                                arg:argument
                                className:cls name
                                selector:sel
                                lineNumber:lineNo
                                info:infoMessage
                                enabled:true.
                            breakpointList add:entry.
                        ].
                        tree acceptVisitor:extractor.
                    ]
                ]
            ].
        ].
    ].

    Smalltalk allClassesDo:[:cls |
        cls selectorsAndMethodsDo:[:sel :mthd |
            update value:cls value:mthd value:sel
        ].
        cls class selectorsAndMethodsDo:[:sel :mthd |
            update value:cls class value:mthd value:sel
        ].
    ].

    showCodeBreakpointsFor := newShowCodeBreakpointsFor.
!

updateCode
    |entry method|

    entry := self selectedBreakpointListEntry.
    entry isNil ifTrue:[
	codeView contents:nil.
	^ self
    ].
    method := entry method.
    method isNil ifTrue:[
	codeView contents:'OOPS - no source found'.
    ] ifFalse:[
	codeView contents:(method source).
	entry lineNumber notNil ifTrue:[
	    codeView cursorLine:entry lineNumber col:1.
	    codeView selectLine:entry lineNumber.
	].
    ].



!

updateShownBreakpointList

    self shownCopyOfBreakpointList contents:breakpointList.
    self filter.
    self resort.


! !

!BreakpointBrowser methodsFor:'initialization & release'!

initialize
    super initialize.

    showCodeBreakpointsFor := Dictionary new.
    breakpointList := List new.

    currentSortColumn := #type.
    currentSortIsReverse := false.
!

postBuildCodeView:aView
    codeView := aView
!

postOpenWith:aBuilder
    super postOpenWith:aBuilder.

    self enqueueMessage:#updateList for:self arguments:#().

    "Modified: / 18-02-2007 / 12:55:57 / cg"
! !

!BreakpointBrowser methodsFor:'menu actions'!

openAboutThisApplication
    super openAboutThisApplication
!

openDocumentation
    HTMLDocumentView openFullOnDocumentationFile:'tools/misc/TOP.html#BREAKPOINTLIST'.

    "/ add application-specific help files under the 'doc/online/<language>/help/appName'
    "/ directory, and open a viewer with:
    "/ HTMLDocumentView openFullOnDocumentationFile:'help/<MyApplication>/TOP.html'.
! !

!BreakpointBrowser methodsFor:'menu actions-item'!

browseItem
    (self breakpointListEntryAtIndex:self selectionIndexHolder value) browse
!

removeItem
    breakpointList remove:(self selectedBreakpointListEntry)

    "Created: / 22-10-2006 / 10:45:52 / cg"
    "Modified: / 18-02-2007 / 12:57:58 / cg"
! !

!BreakpointBrowser methodsFor:'menus-dynamic'!

codeBreakpointMenu
    <resource: #programMenu >

    |breakpointArgs menu|

    breakpointArgs := Set new.
    breakpointList
			select:[:entry | entry arg notNil]
			thenDo:[:entry | breakpointArgs add:entry arg].
    (breakpointList contains:[:entry | entry arg isNil]) ifTrue:[
	breakpointArgs add:'<nil>'.
    ].
    breakpointArgs := breakpointArgs asSortedCollection.

    menu := Menu new.
    breakpointArgs do:[:arg|
	| menuItem |

	menuItem := MenuItem new.
	menuItem label:arg.
	menuItem translateLabel:false.
	menuItem indication:(showCodeBreakpointsFor at:arg ifAbsentPut:[true asValue]).
	menuItem hideMenuOnActivated:false.
	menuItem value:[:onOff |
	    (showCodeBreakpointsFor at:arg ifAbsentPut:[true asValue]) value:onOff.
	    self updateShownBreakpointList
	].
	menu addItem:menuItem.
    ].
    menu findGuiResourcesIn:self.
    ^ menu

    "Modified: / 27-03-2007 / 10:54:29 / cg"
!

enabledCodeBreakpointMenu
    <resource: #programMenu >

    |breakpointArgs menu enabledCodeBreakpointHolders|

    enabledCodeBreakpointHolders := Dictionary new.

    breakpointArgs := Set new.
    breakpointList
			select:[:entry | entry arg notNil]
			thenDo:[:entry | breakpointArgs add:entry arg].
    (breakpointList contains:[:entry | entry arg isNil]) ifTrue:[
	breakpointArgs add:'<nil>'.
    ].
    breakpointArgs := breakpointArgs asSortedCollection.

    menu := Menu new.
    breakpointArgs do:[:arg|
	| menuItem |

	menuItem := MenuItem new.
	menuItem label:arg.
	menuItem translateLabel:false.
	menuItem indication:(enabledCodeBreakpointHolders at:arg ifAbsentPut:[ (Object isBreakPointEnabled:arg) asValue ]).
	menuItem hideMenuOnActivated:false.
	menuItem value:[:onOff |
	    (enabledCodeBreakpointHolders at:arg ifAbsentPut:[(Object isBreakPointEnabled:arg) asValue]) value:onOff.
	    onOff ifFalse:[
		Object disableBreakPoint:arg
	    ] ifTrue:[
		Object enableBreakPoint:arg
	    ].
	].
	menu addItem:menuItem.
    ].
    menu findGuiResourcesIn:self.
    ^ menu

    "Modified: / 27-03-2007 / 10:54:29 / cg"
! !

!BreakpointBrowser methodsFor:'user actions'!

browseSelectedItem
    (self selectedBreakpointListEntry) browse

    "Created: / 22-10-2006 / 01:49:13 / cg"
    "Modified: / 18-02-2007 / 12:56:30 / cg"
!

itemDoubleClicked:itemIndex
    self browseSelectedItem

    "Created: / 22-10-2006 / 01:49:13 / cg"
    "Modified: / 18-02-2007 / 12:56:30 / cg"
!

resort
    |sortBlock sortBlock1|

    currentSortColumn isNil ifTrue:[^ self ].

    sortBlock := sortBlock1 := [:a :b |
				    |vA vB|

				    vA := (a perform:currentSortColumn).
				    vB := (b perform:currentSortColumn).
				    vA = vB ifTrue:[
					currentSortColumn == #type ifTrue:[
					    vA := a arg.
					    vB := b arg.
					    vA = vB ifTrue:[
						vA := a className.
						vB := b className.
						vA = vB ifTrue:[
						    vA := a selector.
						    vB := b selector.
						    vA = vB ifTrue:[
							vA := a lineNumber.
							vB := b lineNumber.
						    ]
						]
					    ]
					]
				    ].
				    (vA ? '') < (vB ? '')
			       ].

    currentSortIsReverse ifTrue:[
	sortBlock := [:a :b | (sortBlock1 value:a value:b) not ].
    ].

    "/ temporary hack - should make a copy of the real list
    self shownCopyOfBreakpointList sort:sortBlock

    "Created: / 25-10-2006 / 01:01:26 / cg"
    "Modified: / 18-02-2007 / 13:02:19 / cg"
!

sortBy:instanceName
    self sortBy:instanceName withReverse:true

    "Created: / 25-10-2006 / 00:53:55 / cg"
!

sortBy:instanceName withReverse:aBoolean
    |aSymbol|

    aSymbol := instanceName asSymbol.

    currentSortColumn isNil ifTrue:[
	currentSortColumn := aSymbol.
	currentSortIsReverse := false.
    ] ifFalse:[
	currentSortColumn = aSymbol ifTrue:[
	    "/ same column like before - change sort order ifReverse is true
	    aBoolean ifTrue:[
		currentSortIsReverse := currentSortIsReverse not.
	    ].
	] ifFalse:[
	    "/ another column - remark column
	    currentSortColumn := aSymbol.
	]
    ].
    self resort.

    "Created: / 25-10-2006 / 00:54:59 / cg"
!

updateList
    self updatingLabelShown value:true.
    "/ cg: mhmh why is this needed ????
    Delay waitForSeconds:0.1.
    self windowGroup repairDamage.

    self withWaitCursorDo:[
	self updateBreakpointList.
	self updateShownBreakpointList.
    ].
    self updatingLabelShown value:false.
! !

!BreakpointBrowser::BreakpointListEntry methodsFor:'accessing'!

arg
    ^ arg
!

className
    ^ className
!

enabled
    ^ enabled
!

info
    ^ info
!

lineNumber
    ^ lineNumber
!

selector
    ^ selector
!

type
    ^ type
!

type:typeArg arg:argArg className:classNameArg selector:selectorArg lineNumber:lineNumberArg info:infoArg enabled:enabledArg
    type := typeArg.
    arg := argArg.
    className := classNameArg.
    selector := selectorArg.
    lineNumber := lineNumberArg.
    info := infoArg.
    enabled := enabledArg.
! !

!BreakpointBrowser::BreakpointListEntry methodsFor:'actions'!

browse
    |browser|

    browser := UserPreferences systemBrowserClass
	openInClass:(Smalltalk classNamed:className) selector:selector.

    lineNumber notNil ifTrue:[
	browser codeView cursorLine:lineNumber col:1.
	browser codeView selectLine:lineNumber.
    ].

!

method
    ^ (Smalltalk classNamed:className) compiledMethodAt:selector.
! !

!BreakpointBrowser::BreakpointListEntry methodsFor:'testing'!

isAssertion
    ^ type == #assertion
!

isCodeBreakpoint
    ^ type == #breakpoint
!

isHalt
    ^ type == #halt
!

isMethodBreakpoint
    ^ type == #wrap
! !

!BreakpointBrowser::MessageArgumentExtractor methodsFor:'accessing'!

callBack:something
    callBack := something.
!

selectorToSearch:something
    selectorToSearch := something.
! !

!BreakpointBrowser::MessageArgumentExtractor methodsFor:'visiting'!

acceptMessageNode: aMessageNode
    |arg1Node arg1 arg2Node arg2 argument infoMessage|

    aMessageNode selector == selectorToSearch ifTrue:[
	aMessageNode arguments size > 0 ifTrue:[
	    arg1Node := aMessageNode arguments first.
	    arg1Node isLiteral ifTrue:[
		arg1 := arg1Node value.
	    ].
	    aMessageNode arguments size > 1 ifTrue:[
		arg2Node := aMessageNode arguments second.
		arg2Node isLiteral ifTrue:[
		    arg2 := arg2Node value.
		].
	    ].
	].

	selectorToSearch == #halt: ifTrue:[
	    infoMessage := arg1.
	].
	selectorToSearch == #breakPoint: ifTrue:[
	    argument := arg1.
	].
	selectorToSearch == #breakPoint:info: ifTrue:[
	    argument := arg1.
	    infoMessage := arg2.
	].
	selectorToSearch == #assert: ifTrue:[
	].
	selectorToSearch == #assert:message: ifTrue:[
	    infoMessage := arg2.
	].

	callBack
	    value:aMessageNode firstLineNumber
	    value:argument
	    value:infoMessage
    ].
    super acceptMessageNode: aMessageNode
! !

!BreakpointBrowser class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libtool/Tools__BreakpointBrowser.st,v 1.5 2008-10-08 07:35:31 cg Exp $'
! !