1Object extend [ 2 3 gtkInspect [ 4 "Open a GtkInspector on self" 5 <category: '*VisualGST'> 6 7 VisualGST.GtkInspector openOn: self 8 ] 9 10 inspectorView [ 11 <category: '*VisualGST'> 12 13 ^ VisualGST.GtkObjectInspectorView 14 ] 15 16 hasLiterals [ 17 <category: '*VisualGST'> 18 19 ^ false 20 ] 21] 22 23CompiledMethod class extend [ 24 ExtensionIcon := nil. 25 OverrideIcon := nil. 26 OverriddenIcon := nil. 27 28 extensionIcon [ 29 <category: '*VisualGST'> 30 31 ^ ExtensionIcon ifNil: [ ExtensionIcon := GTK.GdkPixbuf newFromFile: (VisualGST.GtkLauncher / 'Icons/extension.png') file displayString error: nil ] 32 ] 33 34 extensionsIcon: aGdkPixbuf [ 35 <category: '*VisualGST'> 36 37 ExtensionIcon := aGdkPixbuf 38 ] 39 40 overrideIcon [ 41 <category: '*VisualGST'> 42 43 ^ OverrideIcon ifNil: [ OverrideIcon := GTK.GdkPixbuf newFromFile: (VisualGST.GtkLauncher / 'Icons/override.png') file displayString error: nil ] 44 ] 45 46 overrideIcon: aGdkPixbuf [ 47 <category: '*VisualGST'> 48 49 OverrideIcon := aGdkPixbuf 50 ] 51 52 overriddenIcon [ 53 <category: '*VisualGST'> 54 55 ^ OverriddenIcon ifNil: [ OverriddenIcon := GTK.GdkPixbuf newFromFile: (VisualGST.GtkLauncher / 'Icons/overridden.png') file displayString error: nil ] 56 ] 57 58 overriddenIcon: aGdkPixbuf [ 59 <category: '*VisualGST'> 60 61 OverriddenIcon := aGdkPixbuf 62 ] 63] 64 65CompiledMethod extend [ 66 override [ 67 <category: '*VisualGST'> 68 69 self methodClass superclass ifNil: [ ^ false ]. 70 ^ (self methodClass superclass lookupSelector: self selector) isNil not 71 ] 72 73 overridden [ 74 <category: '*VisualGST'> 75 76 | set | 77 set := Set new. 78 set addAll: self methodClass subclasses. 79 set do: [ :each | 80 each methodDictionary ifNotNil: [ :dic | dic at: self selector ifPresent: [ :mth | ^ true ] ] ]. 81 ^ false 82 ] 83 84 methodViewIcon [ 85 <category: '*VisualGST'> 86 87 self methodCategory first = $* ifTrue: [ ^ self class extensionIcon ]. 88 self overridden ifTrue: [ ^ self class overriddenIcon ]. 89 self override ifTrue: [ ^ self class overrideIcon ]. 90 ^ nil 91 ] 92 93 inspectorView [ 94 <category: '*VisualGST'> 95 96 ^ VisualGST.GtkCompiledMethodInspectorView 97 ] 98] 99 100CompiledBlock extend [ 101 inspectorView [ 102 <category: '*VisualGST'> 103 104 ^ VisualGST.GtkCompiledBlockInspectorView 105 ] 106 107 methodRecompilationSourceString [ 108 <category: '*VisualGST'> 109 110 ^ self method methodRecompilationSourceString 111 ] 112] 113 114SequenceableCollection extend [ 115 inspectorView [ 116 <category: '*VisualGST'> 117 118 ^ VisualGST.GtkSequenceableCollectionInspectorView 119 ] 120] 121 122Set extend [ 123 inspectorView [ 124 <category: '*VisualGST'> 125 126 ^ VisualGST.GtkSetInspectorView 127 ] 128] 129 130Dictionary extend [ 131 inspectorView [ 132 <category: '*VisualGST'> 133 134 ^ VisualGST.GtkDictionaryInspectorView 135 ] 136] 137 138Character extend [ 139 inspectorView [ 140 <category: '*VisualGST'> 141 142 ^ VisualGST.GtkCharacterInspectorView 143 ] 144] 145 146Integer extend [ 147 inspectorView [ 148 <category: '*VisualGST'> 149 150 ^ VisualGST.GtkIntegerInspectorView 151 ] 152] 153 154Float extend [ 155 inspectorView [ 156 <category: '*VisualGST'> 157 158 ^ VisualGST.GtkFloatInspectorView 159 ] 160] 161 162Symbol extend [ 163 hasLiterals [ 164 <category: '*VisualGST'> 165 166 ^ true 167 ] 168 169 symbolFromliterals [ 170 <category: '*VisualGST'> 171 172 ^ {self} 173 ] 174] 175 176Array extend [ 177 hasLiterals [ 178 <category: '*VisualGST'> 179 180 self do: [ :each | 181 each hasLiterals ifTrue: [ ^ true ] ]. 182 ^ false 183 ] 184 185 symbolFromliterals [ 186 <category: '*VisualGST'> 187 188 | result | 189 result := OrderedCollection new. 190 self do: [ :each | 191 each hasLiterals ifTrue: [ result add: each symbolFromliterals first ] ]. 192 ^ result 193 ] 194] 195 196Class extend [ 197 198 subclass: classNameString environment: aNamespace [ 199 <category: '*VisualGST'> 200 201 "Define a subclass of the receiver with the given name. If the class 202 is already defined, don't modify its instance or class variables 203 but still, if necessary, recompile everything needed." 204 205 | meta | 206 KernelInitialized ifFalse: [^Smalltalk at: classNameString]. 207 meta := self metaclassFor: classNameString. 208 ^ meta 209 name: classNameString 210 environment: aNamespace 211 subclassOf: self 212 ] 213] 214 215CompiledCode extend [ 216 217 hasLiterals [ 218 <category: '*VisualGST'> 219 220 ^ self literals isEmpty not 221 ] 222 223 isSendingWithSpecialSelector: aByteCode [ 224 <category: '*VisualGST'> 225 226 ^ aByteCode <= 31 227 ] 228 229 specialSelectorSended: aByteCode and: anOperand [ 230 <category: '*VisualGST'> 231 232 (self isSendingWithSpecialSelector: aByteCode) ifFalse: [ ^ self error: 'bad byte code' ]. 233 aByteCode <= 26 ifTrue: [ ^ self class specialSelectors at: aByteCode + 1 ]. 234 (aByteCode = 30 or: [ aByteCode = 31 ]) ifTrue: [ ^ self class specialSelectors at: anOperand + 1 ]. 235 ] 236 237 extractSpecialSelectors [ 238 <category: '*VisualGST'> 239 240 | result | 241 result := Set new. 242 self allByteCodeIndicesDo: [ :i :bytecode :operand | 243 (self isSendingWithSpecialSelector: bytecode) ifTrue: [ 244 result add: (self specialSelectorSended: bytecode and: operand) ] ]. 245 ^ result 246 ] 247 248 literalsAndSpecialSelectors [ 249 <category: '*VisualGST'> 250 251 "Answer whether the receiver refers to the given object" 252 253 | result | 254 result := Set new. 255 self literalsDo: [ :each | 256 each hasLiterals ifTrue: [ result addAll: each symbolFromliterals ] ]. 257 258 ^ result + self extractSpecialSelectors 259 ] 260 261 literalsAndSpecialSelectorsDo: aOneArgBlock [ 262 <category: '*VisualGST'> 263 264 self literalsAndSpecialSelectors do: aOneArgBlock 265 ] 266 267] 268 269CompiledBlock extend [ 270 symbolFromliterals [ 271 <category: '*VisualGST'> 272 273 ^ self extractSpecialSelectors 274 ] 275] 276 277MethodContext extend [ 278 variables [ 279 <category: '*VisualGST'> 280 281 | variables method | 282 method := self method method parserClass parseMethod: self method method methodSourceString onError: [ :aString :position | ^ variables:= #() ]. 283 (variables := method argumentNames asOrderedCollection) addAll: method body temporaryNames. 284 ^ variables 285 ] 286] 287 288BlockContext extend [ 289 variables [ 290 <category: '*VisualGST'> 291 292 | variables method | 293 method := self method method parserClass parseMethod: self method method methodSourceString. 294 variables := method argumentNames, method body temporaryNames. 295 ^ variables 296 ] 297] 298 299ContextPart extend [ 300 parentContextAt: anInteger [ 301 <category: '*VisualGST'> 302 303 | ctxt i | 304 anInteger <= 0 ifTrue: [ self error: 'Error indice <= 0' ]. 305 self parentContext ifNil: [ self error: 'Error indice too high' ]. 306 anInteger = 1 ifTrue: [ ^ self ]. 307 i := 2. 308 ctxt := self parentContext. 309 [ i < anInteger and: [ ctxt parentContext isNil not ] ] whileTrue: [ 310 ctxt := ctxt parentContext. 311 i := i + 1 ]. 312 ^ i = anInteger 313 ifTrue: [ ctxt ] 314 ifFalse: [ self error: 'Error indice too high' ] 315 ] 316 317 variables [ 318 <category: '*VisualGST'> 319 320 ^ 1 to: self numArgs + self numTemps collect: [ :each | 321 each displayString ] 322 ] 323 324 variablesDo: aBlock [ 325 <category: '*VisualGST'> 326 327 ^ self variables do: aBlock 328 ] 329 330 stackInspectorView [ 331 <category: '*VisualGST'> 332 333 ^ GtkStackInspectorView 334 ] 335] 336 337Debugger extend [ 338 339 receiver [ 340 <category: '*VisualGST'> 341 342 ^ self suspendedContext receiver 343 ] 344 345 myStepInto [ 346 "Run to the end of the current line in the inferior process or to the 347 next message send." 348 349 "TODO: Stop when affectation (get the current bytecode)" 350 <category: '*VisualGST'> 351 | context | 352 context := self suspendedContext. 353 354 [ self stepBytecode. 355 self suspendedContext == context ] 356 whileTrue 357 ] 358 359 myStep [ 360 "Run to the end of the current line in the inferior process, skipping 361 over message sends." 362 363 "TODO: Stop when affectation (get the current bytecode)" 364 <category: '*VisualGST'> 365 | context | 366 context := self suspendedContext. 367 368 [ self stepBytecode. 369 (self suspendedContext notNil and: [ self suspendedContext parentContext == context ]) 370 ifTrue: [ self finish: self suspendedContext. ^ self ]. 371 self suspendedContext == context ] 372 whileTrue 373 ] 374] 375 376Behavior extend [ 377 378 debuggerClass [ 379 <category: '*VisualGST'> 380 381 "^ nil" 382 ^ VisualGST.GtkDebugger 383 ] 384] 385 386VariableBinding extend [ 387 388 hasLiterals [ 389 <category: '*VisualGST'> 390 391 ^ true 392 ] 393 394 symbolFromliterals [ 395 <category: '*VisualGST'> 396 397 ^ {self key} 398 ] 399] 400 401GTK.GtkButton class extend [ 402 403 createButton: aStockId [ 404 <category: 'instance creation'> 405 406 | image | 407 image := GTK.GtkImage newFromStock: aStockId size: GTK.Gtk gtkIconSizeMenu. 408 ^ (GTK.GtkButton new) 409 setImage: image; 410 setRelief: GTK.Gtk gtkReliefNone; 411 yourself 412 ] 413 414 closeButton [ 415 <category: 'instance creation'> 416 417 ^ self createButton: GTK.Gtk gtkStockClose 418 ] 419 420 previousButton [ 421 <category: 'instance creation'> 422 423 ^ self createButton: GTK.Gtk gtkStockGoBack 424 ] 425 426 nextButton [ 427 <category: 'instance creation'> 428 429 ^ self createButton: GTK.Gtk gtkStockGoForward 430 ] 431 432 replaceButton [ 433 <category: 'instance creation'> 434 435 ^ self createButton: GTK.Gtk gtkStockFindAndReplace 436 ] 437] 438 439Metaclass extend [ 440 displaySymbol [ 441 <category: '*VisualGST'> 442 443 ^ self instanceClass name 444 ] 445] 446 447AbstractNamespace extend [ 448 displaySymbol [ 449 <category: '*VisualGST'> 450 451 ^ self displayString asSymbol 452 ] 453] 454 455Symbol extend [ 456 displaySymbol [ 457 <category: '*VisualGST'> 458 459 ^ self 460 ] 461] 462 463CharacterArray extend [ 464 465 deindexOf: aCharacterArray matchCase: aBoolean startingAt: anIndex [ 466 "Answer an Interval of indices in the receiver which match the aCharacterArray 467 pattern. # in aCharacterArray means 'match any character', * in aCharacterArray means 468 'match any sequence of characters'. The first item of the returned interval 469 is >= anIndex. If aBoolean is false, the search is case-insensitive, 470 else it is case-sensitive. If no Interval matches the pattern, answer nil." 471 472 <category: '*VisualGST'> 473 | result | 474 aBoolean 475 ifFalse: 476 [ ^ self asLowercase 477 deindexOf: aCharacterArray asLowercase 478 matchCase: true 479 startingAt: anIndex ]. 480 1 to: anIndex do: 481 [ :i | 482 result := aCharacterArray 483 matchSubstring: 1 484 in: self 485 at: anIndex - i + 1. 486 result notNil ifTrue: [ ^ anIndex - i + 1 to: result ] ]. 487 ^ nil 488 ] 489] 490 491STInST.RBParser class extend [ 492 493 selectedSymbol: aString [ 494 <category: '*VisualGST'> 495 496 | stream parser node | 497 stream := aString readStream. 498 parser := STInST.RBBracketedMethodParser new. 499 parser errorBlock: [ :message :position | ^ nil ]. 500 parser scanner: (parser scannerClass on: stream errorBlock: parser errorBlock). 501 node := parser parseExpression. 502 node := node bestNodeFor: (1 to: aString size). 503 [ node isNil ifTrue: [ ^ nil ]. 504 node isMessage] whileFalse: [ node := node parent ]. 505 ^ node selector 506 ] 507] 508 509GTK.GtkTreeModel class extend [ 510 createModelWith: anArray [ 511 <category: '*VisualGST'> 512 513 | model | 514 model := OrderedCollection new. 515 anArray do: [ :each | model addAll: (each collect: [ :elem | elem kind ]) ]. 516 model addLast: VisualGST.GtkColumnOOPType kind. 517 ^ self new: model size varargs: model asArray 518 ] 519] 520 521GTK.GtkListStore class extend [ 522 createModelWith: anArray [ 523 <category: '*VisualGST'> 524 525 | model | 526 model := OrderedCollection new. 527 anArray do: [ :each | model addAll: (each collect: [ :elem | elem kind ]) ]. 528 model addLast: VisualGST.GtkColumnOOPType kind. 529 ^ self new: model size varargs: model asArray 530 ] 531] 532 533GTK.GtkTreeStore class extend [ 534 createModelWith: anArray [ 535 <category: '*VisualGST'> 536 537 | model | 538 model := OrderedCollection new. 539 anArray do: [ :each | model addAll: (each collect: [ :elem | elem kind ]) ]. 540 model addLast: VisualGST.GtkColumnOOPType kind. 541 ^ self new: model size varargs: model asArray 542 ] 543] 544 545GTK.GtkTreeView class extend [ 546 547 createModel: aGtkStoreClass with: anArray [ 548 <category: '*VisualGST'> 549 550 ^ self newWithModel: (aGtkStoreClass createModelWith: anArray) 551 ] 552 553 createTreeViewWith: anArray [ 554 <category: '*VisualGST'> 555 556 ^ self createModel: GtkTreeStore with: anArray 557 ] 558 559 createListViewWith: anArray [ 560 <category: '*VisualGST'> 561 562 ^ self createModel: GtkListStore with: anArray 563 ] 564 565 createColumnsOn: aGtkTreeView with: anArray [ 566 <category: '*VisualGST'> 567 568 | colView i render | 569 i := 0. 570 anArray do: [ :each | 571 colView := GtkTreeViewColumn new. 572 each do: [ :column | 573 column isVisible ifTrue: [ 574 colView 575 packStart: (render := column cellRenderer new) expand: false; 576 addAttribute: render attribute: column kindName column: i. 577 column hasTitle ifTrue: [ colView setTitle: column title ]. 578 i := i + 1 ] ]. 579 aGtkTreeView insertColumn: colView position: -1 ] 580 ] 581 582 createListWithModel: anArray [ 583 <category: '*VisualGST'> 584 585 | view | 586 view := self createListViewWith: anArray. 587 self createColumnsOn: view with: anArray. 588 ^ view 589 ] 590 591 createTreeWithModel: anArray [ 592 <category: '*VisualGST'> 593 594 | view | 595 view := self createTreeViewWith: anArray. 596 self createColumnsOn: view with: anArray. 597 ^ view 598 ] 599] 600 601GTK.GtkTreeView extend [ 602 | model | 603 604 model: aGtkModel [ 605 <category: 'accessing'> 606 607 model := aGtkModel 608 ] 609 610 model [ 611 <category: 'accessing'> 612 613 ^ model 614 ] 615 616 selection [ 617 <category: 'accessing'> 618 619 | iter string | 620 (iter := self selectedIter) ifNil: [ ^ self error: 'nothing is selected' ]. 621 ^ (self getModel at: iter) last 622 ] 623 624 selections [ 625 <category: 'accessing'> 626 627 | glist result | 628 result := OrderedCollection new. 629 (glist := self getSelection getSelectedRows: nil) ifNil: [ ^ result ]. 630 glist do: [ :each | | iter path | 631 path := each castTo: GTK.GtkTreePath type. 632 iter := self getModel getIter: path. 633 result add: ((self getModel at: iter) last) ]. 634 ^ result 635 ] 636 637 select: anObject [ 638 <category: 'accessing'> 639 640 self getSelection unselectAll. 641 self getModel do: [ :elem :iter | 642 elem last = anObject ifTrue: [ 643 self scrollToCell: (self getModel getPath: iter) column: nil useAlign: false rowAlign: 0.5 colAlign: 0.5. 644 ^ self getSelection selectIter: iter ] ]. 645 ] 646 647 selectNth: anInteger [ 648 <category: 'accessing'> 649 650 | path iter | 651 self getSelection unselectAll. 652 anInteger = 0 ifTrue: [^self]. 653 path := GtkTreePath newFromIndices: {anInteger - 1. -1}. 654 (self getModel getIter: path) isNil ifTrue: [^self]. 655 self scrollToCell: path column: nil useAlign: false rowAlign: 0.5 colAlign: 0.5. 656 self getSelection selectPath: path 657 ] 658 659 selectFirstItem [ 660 <category: 'accessing'> 661 662 | selection | 663 (selection := self getSelection) unselectAll. 664 selection unselectAll. 665 selection selectIter: self getModel getIterFirst 666 ] 667 668 selectLastItem [ 669 <category: 'accessing'> 670 671 | selection | 672 (selection := self getSelection) unselectAll. 673 selection unselectAll. 674 selection selectIter: self getModel getIterLast 675 ] 676] 677 678GTK.GtkDialog extend [ 679 680 showModal [ 681 <category: '*VisualGST'> 682 683 self 684 setModal: true; 685 showAll 686 ] 687 688 destroy: aGtkDialog [ 689 <category: '*VisualGST'> 690 691 self destroy 692 ] 693 694 showModalOnAnswer: aBlock [ 695 <category: '*VisualGST'> 696 697 self 698 setModal: true; 699 connectSignal: 'response' to: aBlock selector: #cull:cull:; 700 showAll 701 ] 702 703 showModalDestroy [ 704 <category: '*VisualGST'> 705 706 self 707 setModal: true; 708 connectSignal: 'response' to: self selector: #destroy:; 709 showAll 710 ] 711 712 showOnAnswer: aBlock [ 713 <category: '*VisualGST'> 714 715 self 716 setModal: false; 717 connectSignal: 'response' to: aBlock selector: #cull:cull:; 718 showAll 719 ] 720] 721 722GTK.GtkWidget extend [ 723 getFocusChild [ 724 <category: '*VisualGST'> 725 ^nil 726 ] 727] 728 729GTK.GtkPaned class extend [ 730 731 addAll: anArray [ 732 733 ^ self addAll: anArray from: 1 734 ] 735 736 addAll: anArray from: anInteger [ 737 738 ^ anArray size - anInteger = 0 739 ifTrue: [ self new 740 pack1: (anArray at: anInteger) resize: true shrink: true; 741 yourself ] 742 ifFalse: [ 743 anArray size - anInteger > 1 ifTrue: [ 744 self new 745 pack1: (anArray at: anInteger) resize: true shrink: true; 746 pack2: (self addAll: anArray from: anInteger + 1) resize: true shrink: false; 747 yourself ] 748 ifFalse: [ self new 749 pack1: (anArray at: anInteger) resize: true shrink: true; 750 pack2: (anArray at: anInteger + 1) resize: true shrink: false; 751 yourself ] ] 752 ] 753 754] 755 756GTK.GtkScrolledWindow class extend [ 757 758 withViewport: aGtkWidget [ 759 <category: 'instance creation'> 760 761 ^ (GTK.GtkScrolledWindow new: nil vadjustment: nil) 762 addWithViewport: aGtkWidget; 763 setPolicy: GTK.Gtk gtkPolicyAutomatic vscrollbarPolicy: GTK.Gtk gtkPolicyAutomatic; 764 yourself 765 ] 766] 767 768Smalltalk.PackageLoader class extend [ 769 root [ 770 <category: 'accessing'> 771 772 ^ root 773 ] 774] 775
