Tools__BreakpointBrowser.st
author Claus Gittinger <cg@exept.de>
Wed, 20 Aug 2008 21:40:26 +0200
changeset 8234 971ce68b9ff6
parent 8233 e2f89abb11d9
child 8241 ea82422336bb
permissions -rw-r--r--
*** empty log message ***

"
 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'!

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|

        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|

            (mthd sends: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"
!

removeItems:entriesToRemove
    entriesToRemove do:[:entryToRemove |
        toDoList remove:entryToRemove
    ].
! !

!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.2 2008-08-20 19:40:26 cg Exp $'
! !