1!ProtoObject subclass: #Object 2 instanceVariableNames: '' 3 classVariableNames: 'DependentsFields' 4 poolDictionaries: '' 5 category: 'Kernel-Objects'! 6 7!Object methodsFor: '*39Deprecated' stamp: 'gk 2/24/2004 08:49'! 8beep 9 "Deprecated." 10 11 self deprecated: 'Use Beeper class>>beep instead.'. 12 Beeper beep! ! 13 14!Object methodsFor: '*39Deprecated' stamp: 'gk 2/24/2004 08:50'! 15beepPrimitive 16 "Deprecated. Beep in the absence of sound support." 17 18 self deprecated: 'Use Beeper class>>beep or Beeper class>>beepPrimitive instead.'. 19 Beeper beepPrimitive! ! 20 21!Object methodsFor: '*39Deprecated' stamp: 'md 12/12/2003 17:02'! 22beep: soundName 23 "Make the given sound, unless the making of sound is disabled in Preferences." 24 25 self deprecated: 'Use SampledSound>>playSoundNamed: instead.'. 26 Preferences soundsEnabled 27 ifTrue: [self playSoundNamed: soundName] 28! ! 29 30!Object methodsFor: '*39Deprecated' stamp: 'sd 11/19/2004 16:57'! 31contentsGetz: x 32 self deprecated: 'there is no method named contents in object and in addition only one sender in a method not called'. 33 self contents: x! ! 34 35!Object methodsFor: '*39Deprecated' stamp: 'sd 11/13/2003 21:10'! 36deprecatedExplanation: aString 37 "This method is OBSOLETE. Use #deprecated: instead." 38 self deprecated: 'Use Object>>deprecated: instead of deprecatedExplanation:.'. 39 40 Preferences showDeprecationWarnings ifTrue: 41 [Deprecation signal: ('{1} has been deprecated. {2}' translated format: {thisContext sender printString. aString})]! ! 42 43!Object methodsFor: '*39Deprecated' stamp: 'sd 11/13/2003 21:11'! 44deprecated: aBlock explanation: aString 45 "This method is OBSOLETE. Use #deprecated:block: instead." 46 self deprecated: 'Use Object>>deprecated:block: instead of deprecated:explanation:.'. 47 48 Preferences showDeprecationWarnings ifTrue: 49 [Deprecation 50 signal: ('{1} has been deprecated. {2}' translated format: {thisContext sender printString. aString})]. 51 ^ aBlock value. 52! ! 53 54!Object methodsFor: '*39Deprecated' stamp: 'md 12/12/2003 16:25'! 55doIfNotNil: aBlock 56 self deprecated: 'use ifNotNilDo:'. 57 ^ self ifNotNilDo: aBlock 58! ! 59 60!Object methodsFor: '*39Deprecated' stamp: 'md 11/27/2004 12:20'! 61ifKindOf: aClass thenDo: aBlock 62 self deprecated: 'Deprecated. Just use #isKindOf:'. 63 ^ (self isKindOf: aClass) ifTrue: [aBlock value: self]! ! 64 65!Object methodsFor: '*39Deprecated' stamp: 'gk 2/23/2004 20:51'! 66playSoundNamed: soundName 67 "Deprecated. 68 Play the sound with the given name." 69 70 self deprecated: 'Use "SoundService default playSoundNamed: aName" instead.'. 71 SoundService default playSoundNamed: soundName! ! 72 73 74!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:23'! 75aidaCanBeLocked 76 "can we get an exclusive lock on that object (not already locked)?" 77 ^false! ! 78 79!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:23'! 80aidaDontCache 81 "don't cache web content in a browser. Appropriate header is added to http response" 82 ^false! ! 83 84!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'! 85aidaIsLocked 86 "is object locked exclusively?" 87 ^false! ! 88 89!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'! 90aidaLock 91 "get an exclusive lock on that object. Until unlocked, noon else can get that lock. Return false if already locked, true if successfull" 92 ^false! ! 93 94!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'! 95aidaUnlock 96 "release an exclusive lock if any" 97 ^true! ! 98 99!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:24'! 100app 101 "fastest and most convinient way to find a web app for that object" 102 ^self webAppFor: self firstSessionFromStack! ! 103 104!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:25'! 105contentType 106 107 "Janko Mivsek, apr98" 108 "return 'text/html' as content type for web pages" 109 110 ^'text/html'! ! 111 112!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:25'! 113deepSearchOfClass: aClassName 114 "finf all objects of that class down in object hierarchy" 115 | objectDictionary class | 116 objectDictionary := IdentityDictionary new. 117 self deepCopyNotIn: objectDictionary. 118 class := aClassName asSymbol. 119 ^objectDictionary keys select: [:each | each class name = class].! ! 120 121!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:26'! 122deepSearchOfObsoleteClasses 123 "find all objects of obsolete classes down in object hierarchy" 124 | objectDictionary | 125 objectDictionary := IdentityDictionary new. 126 self deepCopyNotIn: objectDictionary. 127 ^objectDictionary keys select: [:each | each class isObsolete].! ! 128 129!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:26'! 130expiresTimestamp 131 "until when content of this object wont be changed" 132 "used in http response, override if you like to be included" 133 ^self modifiedTimestamp "to reload pages immediately"! ! 134 135!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:26'! 136firstAppFromStack 137 "try to find a first sender up in calling stack, who is WebApplication" 138 | context | 139 context := thisContext. 140 [context notNil] whileTrue: [ 141 (context receiver isKindOf: WebApplication) ifTrue: [^context receiver]. 142 context := context sender]. 143 ^self firstSessionFromStack lastApp! ! 144 145!Object methodsFor: '*Aida' stamp: 'JM 4/25/2007 21:34'! 146firstSessionFromStack 147 "try to find a first sender up in calling stack, who is AIDASite and get session if that call" 148 | context | 149 context := thisContext. 150 [context notNil] whileTrue: [ 151 (context receiver isKindOf: AIDASite) ifTrue: [^(context at: 3) "always?"]. 152 context := context sender]. 153 ^nil! ! 154 155!Object methodsFor: '*Aida' stamp: 'mivsek 1/10/2008 18:14'! 156forLanguage: aLanguageCodeSymbol 157 "for multilingual support: returns an apropriate instance of itself for that language. 158 Langage is defined by ISO 639 2-letter language code, see 159 http://en.wikipedia.org/wiki/List_of_ISO_639-1_codes" 160 ^false! ! 161 162!Object methodsFor: '*Aida' stamp: 'mivsek 1/10/2008 18:14'! 163isMultilingual 164 "for multilingual support: override this if your domain object responds 165 to #forLanguage: and returns an apropriate instance of itself for that language" 166 ^false! ! 167 168!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'! 169isVersionedObject 170 ^false! ! 171 172!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'! 173isWebApplication 174 ^false! ! 175 176!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'! 177isWebStyle 178 ^false! ! 179 180!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:27'! 181modifiedTimestamp 182 "when this object was last modified" 183 "used in http response, override if you like to be included" 184 ^nil! ! 185 186!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:28'! 187preferedUrl 188 "override with a suggestion for url of this method!! If not already used, 189 it will be considered by URLResolver during automatic url generation" 190 ^nil! ! 191 192!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:28'! 193printWebAppNotFoundFor: aSession 194 | page | 195 page := WebPage new. 196 page addText: 'Cannot find aWebApplication for object a', self class name. 197 ^page! ! 198 199!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:28'! 200printWebPageFor: aSession 201 "find appropriate web application to represent self as web page" 202 203 | webApp | 204 webApp := self webAppFor: aSession. 205 ^webApp notNil 206 ifTrue: [webApp printWebPage] 207 ifFalse: [self printWebAppNotFoundFor: aSession]! ! 208 209!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:29'! 210sendOver: aStream 211 "from Wiki rendering" 212 self printOn: aStream! ! 213 214!Object methodsFor: '*Aida' stamp: 'JM 4/22/2007 15:29'! 215webAppFor: aSession 216 | webApp | 217 aSession isNil ifTrue: [^nil]. 218 webApp := aSession webAppFor: self. 219 webApp notNil ifTrue: [^webApp]. 220 webApp := WebApplication newFor: self on: aSession. 221 webApp notNil ifTrue: [aSession addWebApp: webApp for: self]. 222 ^webApp! ! 223 224 225!Object methodsFor: '*DynamicBindings' stamp: 'svp 3/6/2003 16:08'! 226binding 227 "Answer the DynamicBinding for the receiver (if any)" 228 229 ^Bindings bindingFor: self ifNotBound: [nil]! ! 230 231!Object methodsFor: '*DynamicBindings' stamp: 'svp 4/29/2003 00:35'! 232binding: anObject 233 "Set the dynamic binding for the receiver, if anObject is nil, then 234 remove the receiver's dynamic binding (if any)" 235 236 ^anObject 237 ifNil: [self removeBinding] 238 ifNotNil: [Bindings bind: self to: anObject]! ! 239 240!Object methodsFor: '*DynamicBindings' stamp: 'svp 3/6/2003 16:09'! 241hasBinding 242 "Answer whether or not the receiver has a dynamic binding" 243 244 ^Bindings includesKey: self! ! 245 246!Object methodsFor: '*DynamicBindings' stamp: 'svp 3/6/2003 16:09'! 247removeBinding 248 "Remove the dynamic binding associated with the receiver" 249 250 ^Bindings removeKey: self ifAbsent: []! ! 251 252 253!Object methodsFor: '*KomHttpServer' stamp: 'SVP 8/23/1999 19:17'! 254asHtmlDocumentForRequest: aNetworkRequest 255 256 self error: 257 ('The requested object (', 258 self asString, 259 '), could not be converted into HTML for your browser.')! ! 260 261!Object methodsFor: '*KomHttpServer' stamp: 'SVP 8/23/1999 19:23'! 262asHttpResponseTo: anHttpRequest 263 264 ^(self asHtmlDocumentForRequest: anHttpRequest) 265 asHttpResponseTo: anHttpRequest 266! ! 267 268!Object methodsFor: '*KomHttpServer' stamp: 'svp 5/16/2003 12:47'! 269isComancheModule 270 271 ^false! ! 272 273!Object methodsFor: '*KomHttpServer' stamp: 'SVP 8/17/1999 17:51'! 274mimeType 275 276 ^MIMEDocument defaultContentType! ! 277 278 279!Object methodsFor: '*Morphic-NewCurve-testing''' stamp: 'wiz 12/31/2005 21:31'! 280isNonZero 281"Overriden in Number. This returns the backstop answer for non-numbers" 282^false.! ! 283 284 285!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/25/2006 18:18'! 286when: anEventSelector 287send: aMessageSelector 288to: anObject 289exclusive: aValueHolder 290 291 self 292 when: anEventSelector 293 evaluate: ((ExclusiveWeakMessageSend 294 receiver: anObject 295 selector: aMessageSelector) 296 basicExecuting: aValueHolder)! ! 297 298!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/25/2006 18:17'! 299when: anEventSelector 300send: aMessageSelector 301to: anObject 302with: anArg 303exclusive: aValueHolder 304 305 self 306 when: anEventSelector 307 evaluate: ((ExclusiveWeakMessageSend 308 receiver: anObject 309 selector: aMessageSelector 310 arguments: (Array with: anArg)) 311 basicExecuting: aValueHolder)! ! 312 313!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/25/2006 18:17'! 314when: anEventSelector 315send: aMessageSelector 316to: anObject 317withArguments: anArgArray 318exclusive: aValueHolder 319 320 self 321 when: anEventSelector 322 evaluate: ((ExclusiveWeakMessageSend 323 receiver: anObject 324 selector: aMessageSelector 325 arguments: anArgArray) 326 basicExecuting: aValueHolder)! ! 327 328!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/24/2006 11:50'! 329when: anEventSelector 330sendOnce: aMessageSelector 331to: anObject 332 333 self 334 when: anEventSelector 335 evaluate: (NonReentrantWeakMessageSend 336 receiver: anObject 337 selector: aMessageSelector)! ! 338 339!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/24/2006 11:49'! 340when: anEventSelector 341sendOnce: aMessageSelector 342to: anObject 343with: anArg 344 345 self 346 when: anEventSelector 347 evaluate: (NonReentrantWeakMessageSend 348 receiver: anObject 349 selector: aMessageSelector 350 arguments: (Array with: anArg))! ! 351 352!Object methodsFor: '*Pinesoft-EventEnhancements' stamp: 'gvc 10/24/2006 11:49'! 353when: anEventSelector 354sendOnce: aMessageSelector 355to: anObject 356withArguments: anArgArray 357 358 self 359 when: anEventSelector 360 evaluate: (NonReentrantWeakMessageSend 361 receiver: anObject 362 selector: aMessageSelector 363 arguments: anArgArray)! ! 364 365 366!Object methodsFor: '*Pinesoft-Widgets' stamp: 'gvc 1/10/2007 11:41'! 367okToClose 368 "Sent to models when a window closing. 369 Allows this check to be independent of okToChange." 370 371 ^true! ! 372 373!Object methodsFor: '*Pinesoft-Widgets' stamp: 'gvc 4/17/2007 17:41'! 374taskbarIcon 375 "Answer the icon for the receiver in a task bar 376 or nil for the default." 377 378 ^self class taskbarIcon! ! 379 380 381!Object methodsFor: '*Pinesoft-Widgets-override' stamp: 'gvc 9/4/2007 12:32'! 382windowActiveOnFirstClick 383 "Return true if my window should be active on first click." 384 385 ^true! ! 386 387 388!Object methodsFor: '*SeasideAdaptersCompatibility' stamp: 'pmm 11/25/2007 14:17'! 389toString 390 ^self! ! 391 392 393!Object methodsFor: '*Tools-Explorer' stamp: 'stephaneducasse 9/17/2005 21:52'! 394exploreAndYourself 395 "i.e. explore; yourself. Thisway i can peek w/o typing all the parentheses" 396 self explore. 397 ^self! ! 398 399!Object methodsFor: '*Tools-Explorer' stamp: 'stephaneducasse 9/17/2005 21:48'! 400exploreWithLabel: label 401 402 ^ ObjectExplorer new openExplorerFor: self withLabel: 403label! ! 404 405 406!Object methodsFor: '*kernel-extensions-flagging' stamp: 'mtf 1/26/2008 23:34'! 407deprecated 408 "Warn that the sending method has been deprecated." 409 410 Preferences showDeprecationWarnings ifTrue: 411 [Deprecation signal: thisContext sender printString, ' has been deprecated.']! ! 412 413 414!Object methodsFor: '*kernel-extensions-flexibility' stamp: 'kph 1/27/2008 19:21'! 415askFor: selector 416 417 "returns true or false" 418 419 ^ (self askFor: selector ifAbsent: nil) == true! ! 420 421!Object methodsFor: '*kernel-extensions-flexibility' stamp: 'kph 10/17/2007 14:01'! 422askFor: selector ifAbsent: aBlock 423 424 "enables a default value to be specified in order to be tolerant of potentially missing methods 425 426 e.g. 427 (myPoint askFor: #originOffset) ifAbsent: [ 0@0 ]. 428 " 429 430 ^ (self class canUnderstand: selector) ifFalse: [ aBlock value ] ifTrue: [self perform: selector]! ! 431 432 433!Object methodsFor: '*kernel-extensions-logging' stamp: 'mtf 1/26/2008 23:52'! 434log 435 "This method provides the univeral entry point fo all logging mechanisms" 436 437 "Options: 438 1. Null for null logging 439 2. A LogRouter instance wih a FrameworkAdaptor. 440 3. CurrentLog a process local variable supplying a LogRouter" 441 442 ^ (Smalltalk at: #CurrentLog ifAbsent: [ Null default ]) value 443 sender: thisContext sender; beginEntry; yourself! ! 444 445 446!Object methodsFor: '*magritte-model-accessing' stamp: 'lr 3/9/2006 11:31'! 447description 448 "Return the description of the reciever. Subclasses might override this message to return instance-based descriptions." 449 450 ^ self class description! ! 451 452!Object methodsFor: '*magritte-model-accessing' stamp: 'lr 3/9/2006 11:31'! 453mementoClass 454 "Return a class to be used to remember or cache the receiver, namely a memento object." 455 456 ^ MACheckedMemento! ! 457 458 459!Object methodsFor: '*magritte-model-model' stamp: 'lr 3/9/2006 11:31'! 460readUsing: aDescription 461 "Dispatch the read-access to the receiver using the accessor of aDescription." 462 463 ^ aDescription accessor read: self! ! 464 465!Object methodsFor: '*magritte-model-model' stamp: 'lr 3/9/2006 11:31'! 466write: anObject using: aDescription 467 "Dispatch the write-access to the receiver of anObject using the accessor of aDescription." 468 469 aDescription accessor write: anObject to: self! ! 470 471 472!Object methodsFor: '*magritte-model-testing' stamp: 'lr 3/9/2006 11:31'! 473isDescription 474 ^ false! ! 475 476 477!Object methodsFor: '*magritte-morph-converting' stamp: 'lr 3/9/2006 11:33'! 478asMorph 479 ^ self description asMorphOn: self! ! 480 481 482!Object methodsFor: '*magritte-seaside-converting' stamp: 'lr 3/9/2006 11:33'! 483asComponent 484 ^ self description asComponentOn: self! ! 485 486 487!Object methodsFor: '*monticello' stamp: 'dvf 8/10/2004 23:25'! 488isConflict 489 ^false! ! 490 491 492!Object methodsFor: '*null' stamp: 'kph 9/6/2007 23:31'! 493ifNull: aBlock 494 495 ^ self! ! 496 497!Object methodsFor: '*null' stamp: 'kph 9/6/2007 23:33'! 498isNull 499 500 ^ false! ! 501 502!Object methodsFor: '*null' stamp: 'kph 4/12/2007 08:27'! 503orNull 504 505 ^ self! ! 506 507 508!Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:07'! 509basicInspectorNodes 510 <inspector: #'1' priority: 600> 511 512 | nodes | 513 nodes := OrderedCollection new: self class instSize + self basicSize + 5. 514 nodes add: self selfInspectorNode. 515 self class allInstVarNames withIndexDo: [ :name :index | 516 nodes add: (OTNamedVariableNode on: self index: index name: name) ]. 517 1 to: self basicSize do: [ :index | 518 nodes add: (OTIndexedVariableNode on: self index: index) ]. 519 ^ nodes! ! 520 521!Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 11:07'! 522protocolInspectorNodes 523 <inspector: #'#' priority: 800> 524 525 ^ self class allSelectors asArray sort 526 collect: [ :each | OTProtocolInspectorNode on: self selector: each ]! ! 527 528!Object methodsFor: '*ob-tools-inspector' stamp: 'lr 6/5/2008 09:58'! 529selfInspectorNode 530 ^ OTDerivedInspectorNode on: self label: 'self' block: [ :obj | obj ]! ! 531 532 533!Object methodsFor: '*omnibrowser-converting' stamp: 'cwp 4/17/2006 12:16'! 534asAnnouncement 535 ^ self! ! 536 537 538!Object methodsFor: '*pier-model' stamp: 'lr 3/9/2006 11:29'! 539accept: aVisitor 540 self subclassResponsibility! ! 541 542!Object methodsFor: '*pier-model' stamp: 'lr 3/9/2006 11:29'! 543acceptDecorated: aVisitor 544 self accept: aVisitor! ! 545 546 547!Object methodsFor: '*rio-kernel' stamp: 'kph 3/8/2007 21:25'! 548isRio 549 550 ^ false! ! 551 552 553!Object methodsFor: '*scriptaculous' stamp: 'lr 1/4/2007 17:20'! 554asFunction 555 ^ self asFunction: #()! ! 556 557!Object methodsFor: '*scriptaculous' stamp: 'lr 1/4/2007 17:21'! 558asFunction: aCollection 559 ^ SUFunction new add: self; arguments: aCollection! ! 560 561!Object methodsFor: '*scriptaculous' stamp: 'lr 4/11/2006 19:49'! 562asJavascript 563 ^ String streamContents: [ :stream | self javascriptOn: stream ]! ! 564 565 566!Object methodsFor: '*scriptaculous-printing' stamp: 'lr 4/20/2006 21:10'! 567javascriptOn: aStream 568 self printOn: aStream! ! 569 570 571!Object methodsFor: '*seaside2' stamp: 'lr 6/5/2007 21:35'! 572deprecatedApi 573 self deprecatedApi: thisContext sender displayString! ! 574 575!Object methodsFor: '*seaside2' stamp: 'lr 6/5/2007 21:35'! 576deprecatedApi: aString 577 WADeprecatedApi raiseSignal: aString! ! 578 579!Object methodsFor: '*seaside2' stamp: 'lr 5/9/2007 08:47'! 580inspectorFields 581 | members | 582 members := Array new writeStream. 583 self class allInstVarNames withIndexDo: [ :each :index | 584 members nextPut: each -> (self instVarAt: index) ]. 585 self class isVariable ifTrue: [ 586 1 to: self size do: [ :index | 587 members nextPut: index -> (self at: index) ] ]. 588 ^ members contents! ! 589 590!Object methodsFor: '*seaside2' stamp: 'avi 3/14/2005 15:19'! 591labelForSelector: aSymbol 592 ^ aSymbol asCapitalizedPhrase! ! 593 594!Object methodsFor: '*seaside2' stamp: 'pmm 4/7/2007 17:14'! 595renderOn: aRenderer 596 "Override this method to customize how objects (not components) are rendered when passed as an argument to #render:. The default is the return value of #displayString. 597 Just remember that you can not use #callback:, #on:of:, or #call:" 598 599 aRenderer text: self! ! 600 601!Object methodsFor: '*seaside2' stamp: 'lr 3/19/2007 23:13'! 602restoreFromSnapshot: anObject 603 self copyFrom: anObject! ! 604 605!Object methodsFor: '*seaside2' stamp: 'avi 9/1/2004 21:20'! 606snapshotCopy 607 ^ self shallowCopy! ! 608 609!Object methodsFor: '*seaside2' stamp: 'lr 10/28/2007 14:42'! 610validationError: message 611 ^WAValidationNotification raiseSignal: message! ! 612 613 614!Object methodsFor: '*seaside2-encoding' stamp: 'lr 3/26/2007 20:16'! 615encodeOn: aDocument 616 aDocument print: self displayString! ! 617 618 619!Object methodsFor: '*seaside2-squeak' stamp: 'pmm 5/22/2007 22:10'! 620beMutable 621 "for VW compatibility, a hack that allows to cache a value in a literal array"! ! 622 623!Object methodsFor: '*seaside2-squeak' stamp: 'lr 7/12/2005 17:01'! 624displayString 625 ^ self asString! ! 626 627 628!Object methodsFor: '*services-base' stamp: 'rr 3/21/2006 11:54'! 629requestor 630 "returns the focused window's requestor" 631 632 "SystemWindow focusedWindow ifNotNilDo: [:w | ^ w requestor]." 633 634 "triggers an infinite loop" 635 636 ^ Requestor default! ! 637 638 639!Object methodsFor: '*system-support' stamp: 'dvf 8/23/2003 12:27'! 640systemNavigation 641 642 ^ SystemNavigation default! ! 643 644 645!Object methodsFor: '*tools-browser' stamp: 'mu 3/6/2004 15:13'! 646browse 647 self systemNavigation browseClass: self class! ! 648 649!Object methodsFor: '*tools-browser' stamp: 'mu 3/11/2004 16:00'! 650browseHierarchy 651 self systemNavigation browseHierarchy: self class! ! 652 653 654!Object methodsFor: '*universes' stamp: 'ls 11/26/2006 12:33'! 655isUPackage 656 ^false! ! 657 658!Object methodsFor: '*universes' stamp: 'ls 11/26/2006 12:33'! 659isUPackageCategory 660 ^false! ! 661 662 663!Object methodsFor: 'accessing' stamp: 'sw 4/30/1998 12:18'! 664addInstanceVarNamed: aName withValue: aValue 665 "Add an instance variable named aName and give it value aValue" 666 self class addInstVarName: aName asString. 667 self instVarAt: self class instSize put: aValue! ! 668 669!Object methodsFor: 'accessing' stamp: 'yo 6/29/2004 11:39'! 670at: index 671 "Primitive. Assumes receiver is indexable. Answer the value of an 672 indexable element in the receiver. Fail if the argument index is not an 673 Integer or is out of bounds. Essential. See Object documentation 674 whatIsAPrimitive." 675 676 <primitive: 60> 677 index isInteger ifTrue: 678 [self class isVariable 679 ifTrue: [self errorSubscriptBounds: index] 680 ifFalse: [self errorNotIndexable]]. 681 index isNumber 682 ifTrue: [^self at: index asInteger] 683 ifFalse: [self errorNonIntegerIndex]! ! 684 685!Object methodsFor: 'accessing'! 686at: index modify: aBlock 687 "Replace the element of the collection with itself transformed by the block" 688 ^ self at: index put: (aBlock value: (self at: index))! ! 689 690!Object methodsFor: 'accessing' stamp: 'yo 6/29/2004 13:08'! 691at: index put: value 692 "Primitive. Assumes receiver is indexable. Store the argument value in 693 the indexable element of the receiver indicated by index. Fail if the 694 index is not an Integer or is out of bounds. Or fail if the value is not of 695 the right type for this kind of collection. Answer the value that was 696 stored. Essential. See Object documentation whatIsAPrimitive." 697 698 <primitive: 61> 699 index isInteger ifTrue: 700 [self class isVariable 701 ifTrue: [(index >= 1 and: [index <= self size]) 702 ifTrue: [self errorImproperStore] 703 ifFalse: [self errorSubscriptBounds: index]] 704 ifFalse: [self errorNotIndexable]]. 705 index isNumber 706 ifTrue: [^self at: index asInteger put: value] 707 ifFalse: [self errorNonIntegerIndex]! ! 708 709!Object methodsFor: 'accessing' stamp: 'yo 9/20/2004 10:22'! 710basicAddInstanceVarNamed: aName withValue: aValue 711 "Add an instance variable named aName and give it value aValue" 712 self class addInstVarName: aName asString. 713 self instVarAt: self class instSize put: aValue! ! 714 715!Object methodsFor: 'accessing'! 716basicAt: index 717 "Primitive. Assumes receiver is indexable. Answer the value of an 718 indexable element in the receiver. Fail if the argument index is not an 719 Integer or is out of bounds. Essential. Do not override in a subclass. See 720 Object documentation whatIsAPrimitive." 721 722 <primitive: 60> 723 index isInteger ifTrue: [self errorSubscriptBounds: index]. 724 index isNumber 725 ifTrue: [^self basicAt: index asInteger] 726 ifFalse: [self errorNonIntegerIndex]! ! 727 728!Object methodsFor: 'accessing'! 729basicAt: index put: value 730 "Primitive. Assumes receiver is indexable. Store the second argument 731 value in the indexable element of the receiver indicated by index. Fail 732 if the index is not an Integer or is out of bounds. Or fail if the value is 733 not of the right type for this kind of collection. Answer the value that 734 was stored. Essential. Do not override in a subclass. See Object 735 documentation whatIsAPrimitive." 736 737 <primitive: 61> 738 index isInteger 739 ifTrue: [(index >= 1 and: [index <= self size]) 740 ifTrue: [self errorImproperStore] 741 ifFalse: [self errorSubscriptBounds: index]]. 742 index isNumber 743 ifTrue: [^self basicAt: index asInteger put: value] 744 ifFalse: [self errorNonIntegerIndex]! ! 745 746!Object methodsFor: 'accessing'! 747basicSize 748 "Primitive. Answer the number of indexable variables in the receiver. 749 This value is the same as the largest legal subscript. Essential. Do not 750 override in any subclass. See Object documentation whatIsAPrimitive." 751 752 <primitive: 62> 753 "The number of indexable fields of fixed-length objects is 0" 754 ^0 ! ! 755 756!Object methodsFor: 'accessing'! 757bindWithTemp: aBlock 758 ^ aBlock value: self value: nil! ! 759 760!Object methodsFor: 'accessing' stamp: 'md 10/7/2004 15:43'! 761ifNil: nilBlock ifNotNilDo: aBlock 762 "Evaluate aBlock with the receiver as its argument." 763 764 ^ aBlock value: self 765! ! 766 767!Object methodsFor: 'accessing' stamp: 'di 11/8/2000 21:04'! 768ifNotNilDo: aBlock 769 "Evaluate the given block with the receiver as its argument." 770 771 ^ aBlock value: self 772! ! 773 774!Object methodsFor: 'accessing' stamp: 'md 10/7/2004 15:43'! 775ifNotNilDo: aBlock ifNil: nilBlock 776 "Evaluate aBlock with the receiver as its argument." 777 778 ^ aBlock value: self 779! ! 780 781!Object methodsFor: 'accessing' stamp: 'ajh 1/21/2003 12:59'! 782in: aBlock 783 "Evaluate the given block with the receiver as its argument." 784 785 ^ aBlock value: self 786! ! 787 788!Object methodsFor: 'accessing' stamp: 'sw 10/17/2000 11:15'! 789presenter 790 "Answer the presenter object associated with the receiver. For morphs, there is in effect a clear containment hierarchy of presenters (accessed via their association with PasteUpMorphs); for arbitrary objects the hook is simply via the current world, at least at present." 791 792 ^ self currentWorld presenter! ! 793 794!Object methodsFor: 'accessing'! 795readFromString: aString 796 "Create an object based on the contents of aString." 797 798 ^self readFrom: (ReadStream on: aString)! ! 799 800!Object methodsFor: 'accessing' stamp: 'di 3/29/1999 13:10'! 801size 802 "Primitive. Answer the number of indexable variables in the receiver. 803 This value is the same as the largest legal subscript. Essential. See Object 804 documentation whatIsAPrimitive." 805 806 <primitive: 62> 807 self class isVariable ifFalse: [self errorNotIndexable]. 808 ^ 0! ! 809 810!Object methodsFor: 'accessing' stamp: 'md 5/16/2006 12:34'! 811yourself 812 "Answer self." 813 ^self! ! 814 815 816!Object methodsFor: 'associating' stamp: 'md 7/22/2005 16:03'! 817-> anObject 818 "Answer an Association between self and anObject" 819 820 ^Association basicNew key: self value: anObject! ! 821 822 823!Object methodsFor: 'binding'! 824bindingOf: aString 825 ^nil! ! 826 827 828!Object methodsFor: 'breakpoint' stamp: 'bkv 7/1/2003 12:33'! 829break 830 "This is a simple message to use for inserting breakpoints during debugging. 831 The debugger is opened by sending a signal. This gives a chance to restore 832 invariants related to multiple processes." 833 834 BreakPoint signal. 835 836 "nil break."! ! 837 838 839!Object methodsFor: 'casing'! 840caseOf: aBlockAssociationCollection 841 "The elements of aBlockAssociationCollection are associations between blocks. 842 Answer the evaluated value of the first association in aBlockAssociationCollection 843 whose evaluated key equals the receiver. If no match is found, report an error." 844 845 ^ self caseOf: aBlockAssociationCollection otherwise: [self caseError] 846 847"| z | z _ {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z" 848"| z | z _ {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z" 849"The following are compiled in-line:" 850"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}" 851"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}"! ! 852 853!Object methodsFor: 'casing'! 854caseOf: aBlockAssociationCollection otherwise: aBlock 855 "The elements of aBlockAssociationCollection are associations between blocks. 856 Answer the evaluated value of the first association in aBlockAssociationCollection 857 whose evaluated key equals the receiver. If no match is found, answer the result 858 of evaluating aBlock." 859 860 aBlockAssociationCollection associationsDo: 861 [:assoc | (assoc key value = self) ifTrue: [^assoc value value]]. 862 ^ aBlock value 863 864"| z | z _ {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]" 865"| z | z _ {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]}. #b caseOf: z otherwise: [0]" 866"The following are compiled in-line:" 867"#b caseOf: {[#a]->[1+1]. ['b' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]" 868"#b caseOf: {[#a]->[1+1]. ['d' asSymbol]->[2+2]. [#c]->[3+3]} otherwise: [0]"! ! 869 870 871!Object methodsFor: 'class membership'! 872class 873 "Primitive. Answer the object which is the receiver's class. Essential. See 874 Object documentation whatIsAPrimitive." 875 876 <primitive: 111> 877 self primitiveFailed! ! 878 879!Object methodsFor: 'class membership' stamp: 'sw 9/27/2001 15:51'! 880inheritsFromAnyIn: aList 881 "Answer whether the receiver inherits from any class represented by any element in the list. The elements of the list can be classes, class name symbols, or strings representing possible class names. This allows speculative membership tests to be made even when some of the classes may not be known to the current image, and even when their names are not interned symbols." 882 883 | aClass | 884 aList do: 885 [:elem | Symbol hasInterned: elem asString ifTrue: 886 [:elemSymbol | (((aClass _ Smalltalk at: elemSymbol ifAbsent: [nil]) isKindOf: Class) 887 and: [self isKindOf: aClass]) 888 ifTrue: 889 [^ true]]]. 890 ^ false 891 892 893" 894{3. true. 'olive'} do: 895 [:token | 896 {{#Number. #Boolean}. {Number. Boolean }. {'Number'. 'Boolean'}} do: 897 [:list | 898 Transcript cr; show: token asString, ' list element provided as a ', list first class name, ' - ', (token inheritsFromAnyIn: list) asString]] 899"! ! 900 901!Object methodsFor: 'class membership'! 902isKindOf: aClass 903 "Answer whether the class, aClass, is a superclass or class of the receiver." 904 905 self class == aClass 906 ifTrue: [^true] 907 ifFalse: [^self class inheritsFrom: aClass]! ! 908 909!Object methodsFor: 'class membership' stamp: 'sw 2/16/98 02:08'! 910isKindOf: aClass orOf: anotherClass 911 "Answer whether either of the classes, aClass or anotherClass,, is a superclass or class of the receiver. A convenience; could be somewhat optimized" 912 ^ (self isKindOf: aClass) or: [self isKindOf: anotherClass]! ! 913 914!Object methodsFor: 'class membership'! 915isMemberOf: aClass 916 "Answer whether the receiver is an instance of the class, aClass." 917 918 ^self class == aClass! ! 919 920!Object methodsFor: 'class membership'! 921respondsTo: aSymbol 922 "Answer whether the method dictionary of the receiver's class contains 923 aSymbol as a message selector." 924 925 ^self class canUnderstand: aSymbol! ! 926 927!Object methodsFor: 'class membership' stamp: 'tk 10/21/1998 12:38'! 928xxxClass 929 "For subclasses of nil, such as ObjectOut" 930 ^ self class! ! 931 932 933!Object methodsFor: 'comparing' stamp: 'tk 4/16/1999 18:26'! 934closeTo: anObject 935 "Answer whether the receiver and the argument represent the same 936 object. If = is redefined in any subclass, consider also redefining the 937 message hash." 938 939 | ans | 940 [ans _ self = anObject] ifError: [:aString :aReceiver | ^ false]. 941 ^ ans! ! 942 943!Object methodsFor: 'comparing'! 944hash 945 "Answer a SmallInteger whose value is related to the receiver's identity. 946 May be overridden, and should be overridden in any classes that define = " 947 948 ^ self identityHash! ! 949 950!Object methodsFor: 'comparing' stamp: 'pm 9/23/97 09:36'! 951hashMappedBy: map 952 "Answer what my hash would be if oops changed according to map." 953 954 ^map newHashFor: self! ! 955 956!Object methodsFor: 'comparing' stamp: 'di 9/27/97 20:23'! 957identityHashMappedBy: map 958 "Answer what my hash would be if oops changed according to map." 959 960 ^map newHashFor: self! ! 961 962!Object methodsFor: 'comparing' stamp: 'sw 8/20/1998 12:34'! 963identityHashPrintString 964 "'fred' identityHashPrintString" 965 966 ^ '(', self identityHash printString, ')'! ! 967 968!Object methodsFor: 'comparing' stamp: 'ajh 2/2/2002 15:02'! 969literalEqual: other 970 971 ^ self class == other class and: [self = other]! ! 972 973!Object methodsFor: 'comparing'! 974= anObject 975 "Answer whether the receiver and the argument represent the same 976 object. If = is redefined in any subclass, consider also redefining the 977 message hash." 978 979 ^self == anObject! ! 980 981!Object methodsFor: 'comparing'! 982~= anObject 983 "Answer whether the receiver and the argument do not represent the 984 same object." 985 986 ^self = anObject == false! ! 987 988 989!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'! 990adaptToFloat: rcvr andSend: selector 991 "If no method has been provided for adapting an object to a Float, 992 then it may be adequate to simply adapt it to a number." 993 ^ self adaptToNumber: rcvr andSend: selector! ! 994 995!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:14'! 996adaptToFraction: rcvr andSend: selector 997 "If no method has been provided for adapting an object to a Fraction, 998 then it may be adequate to simply adapt it to a number." 999 ^ self adaptToNumber: rcvr andSend: selector! ! 1000 1001!Object methodsFor: 'converting' stamp: 'di 11/9/1998 12:15'! 1002adaptToInteger: rcvr andSend: selector 1003 "If no method has been provided for adapting an object to a Integer, 1004 then it may be adequate to simply adapt it to a number." 1005 ^ self adaptToNumber: rcvr andSend: selector! ! 1006 1007!Object methodsFor: 'converting' stamp: 'rw 4/27/2002 07:48'! 1008asActionSequence 1009 1010 ^WeakActionSequence with: self! ! 1011 1012!Object methodsFor: 'converting' stamp: 'rw 7/20/2003 16:03'! 1013asActionSequenceTrappingErrors 1014 1015 ^WeakActionSequenceTrappingErrors with: self! ! 1016 1017!Object methodsFor: 'converting' stamp: 'svp 5/16/2000 18:14'! 1018asDraggableMorph 1019 ^(StringMorph contents: self printString) 1020 color: Color white; 1021 yourself! ! 1022 1023!Object methodsFor: 'converting' stamp: 'sma 5/12/2000 17:39'! 1024asOrderedCollection 1025 "Answer an OrderedCollection with the receiver as its only element." 1026 1027 ^ OrderedCollection with: self! ! 1028 1029!Object methodsFor: 'converting'! 1030asString 1031 "Answer a string that represents the receiver." 1032 1033 ^ self printString ! ! 1034 1035!Object methodsFor: 'converting' stamp: 'ajh 3/11/2003 10:27'! 1036asStringOrText 1037 "Answer a string that represents the receiver." 1038 1039 ^ self printString ! ! 1040 1041!Object methodsFor: 'converting'! 1042as: aSimilarClass 1043 "Create an object of class aSimilarClass that has similar contents to the receiver." 1044 1045 ^ aSimilarClass newFrom: self! ! 1046 1047!Object methodsFor: 'converting' stamp: 'RAA 8/2/1999 12:41'! 1048complexContents 1049 1050 ^self! ! 1051 1052!Object methodsFor: 'converting' stamp: 'ajh 7/6/2003 20:37'! 1053mustBeBoolean 1054 "Catches attempts to test truth of non-Booleans. This message is sent from the VM. The sending context is rewound to just before the jump causing this exception." 1055 1056 ^ self mustBeBooleanIn: thisContext sender! ! 1057 1058!Object methodsFor: 'converting' stamp: 'ajh 7/6/2003 20:40'! 1059mustBeBooleanIn: context 1060 "context is the where the non-boolean error occurred. Rewind context to before jump then raise error." 1061 1062 | proceedValue | 1063 context skipBackBeforeJump. 1064 proceedValue _ NonBooleanReceiver new 1065 object: self; 1066 signal: 'proceed for truth.'. 1067 ^ proceedValue ~~ false! ! 1068 1069!Object methodsFor: 'converting' stamp: 'sw 3/26/2001 12:12'! 1070printDirectlyToDisplay 1071 "For debugging: write the receiver's printString directly to the display at (0, 100); senders of this are detected by the check-for-slips mechanism." 1072 1073 self asString displayAt: 0@100 1074 1075"StringMorph someInstance printDirectlyToDisplay"! ! 1076 1077!Object methodsFor: 'converting' stamp: 'RAA 3/31/1999 12:13'! 1078withoutListWrapper 1079 1080 ^self! ! 1081 1082 1083!Object methodsFor: 'copying'! 1084clone 1085 1086 <primitive: 148> 1087 self primitiveFailed! ! 1088 1089!Object methodsFor: 'copying' stamp: 'ajh 8/18/2001 21:25'! 1090copy 1091 "Answer another instance just like the receiver. Subclasses typically override postCopy; they typically do not override shallowCopy." 1092 1093 ^self shallowCopy postCopy! ! 1094 1095!Object methodsFor: 'copying' stamp: 'tk 8/20/1998 16:01'! 1096copyAddedStateFrom: anotherObject 1097 "Copy over the values of instance variables added by the receiver's class from anotherObject to the receiver. These will be remapped in mapUniClasses, if needed." 1098 1099 self class superclass instSize + 1 to: self class instSize do: 1100 [:index | self instVarAt: index put: (anotherObject instVarAt: index)]! ! 1101 1102!Object methodsFor: 'copying' stamp: 'tpr 2/14/2004 21:53'! 1103copyFrom: anotherObject 1104 "Copy to myself all instance variables I have in common with anotherObject. This is dangerous because it ignores an object's control over its own inst vars. " 1105 1106 | mine his | 1107 <primitive: 168> 1108 mine _ self class allInstVarNames. 1109 his _ anotherObject class allInstVarNames. 1110 1 to: (mine size min: his size) do: [:ind | 1111 (mine at: ind) = (his at: ind) ifTrue: [ 1112 self instVarAt: ind put: (anotherObject instVarAt: ind)]]. 1113 self class isVariable & anotherObject class isVariable ifTrue: [ 1114 1 to: (self basicSize min: anotherObject basicSize) do: [:ind | 1115 self basicAt: ind put: (anotherObject basicAt: ind)]].! ! 1116 1117!Object methodsFor: 'copying' stamp: 'ajh 5/23/2002 00:38'! 1118copySameFrom: otherObject 1119 "Copy to myself all instance variables named the same in otherObject. 1120 This ignores otherObject's control over its own inst vars." 1121 1122 | myInstVars otherInstVars match | 1123 myInstVars _ self class allInstVarNames. 1124 otherInstVars _ otherObject class allInstVarNames. 1125 myInstVars doWithIndex: [:each :index | 1126 (match _ otherInstVars indexOf: each) > 0 ifTrue: 1127 [self instVarAt: index put: (otherObject instVarAt: match)]]. 1128 1 to: (self basicSize min: otherObject basicSize) do: [:i | 1129 self basicAt: i put: (otherObject basicAt: i)]. 1130! ! 1131 1132!Object methodsFor: 'copying' stamp: 'tk 4/20/1999 14:44'! 1133copyTwoLevel 1134 "one more level than a shallowCopy" 1135 1136 | newObject class index | 1137 class _ self class. 1138 newObject _ self clone. 1139 newObject == self ifTrue: [^ self]. 1140 class isVariable 1141 ifTrue: 1142 [index _ self basicSize. 1143 [index > 0] 1144 whileTrue: 1145 [newObject basicAt: index put: (self basicAt: index) shallowCopy. 1146 index _ index - 1]]. 1147 index _ class instSize. 1148 [index > 0] 1149 whileTrue: 1150 [newObject instVarAt: index put: (self instVarAt: index) shallowCopy. 1151 index _ index - 1]. 1152 ^newObject! ! 1153 1154!Object methodsFor: 'copying'! 1155deepCopy 1156 "Answer a copy of the receiver with its own copy of each instance 1157 variable." 1158 1159 | newObject class index | 1160 class _ self class. 1161 (class == Object) ifTrue: [^self]. 1162 class isVariable 1163 ifTrue: 1164 [index _ self basicSize. 1165 newObject _ class basicNew: index. 1166 [index > 0] 1167 whileTrue: 1168 [newObject basicAt: index put: (self basicAt: index) deepCopy. 1169 index _ index - 1]] 1170 ifFalse: [newObject _ class basicNew]. 1171 index _ class instSize. 1172 [index > 0] 1173 whileTrue: 1174 [newObject instVarAt: index put: (self instVarAt: index) deepCopy. 1175 index _ index - 1]. 1176 ^newObject! ! 1177 1178!Object methodsFor: 'copying' stamp: 'hg 11/23/1999 13:43'! 1179initialDeepCopierSize 1180 "default value is 4096; other classes may override this, esp. for smaller (=faster) sizes" 1181 1182 ^4096! ! 1183 1184!Object methodsFor: 'copying' stamp: 'ajh 1/27/2003 18:45'! 1185postCopy 1186 "self is a shallow copy, subclasses should copy fields as necessary to complete the full copy" 1187 1188 ^ self! ! 1189 1190!Object methodsFor: 'copying' stamp: 'jm 11/14/97 11:08'! 1191shallowCopy 1192 "Answer a copy of the receiver which shares the receiver's instance variables." 1193 | class newObject index | 1194 <primitive: 148> 1195 class _ self class. 1196 class isVariable 1197 ifTrue: 1198 [index _ self basicSize. 1199 newObject _ class basicNew: index. 1200 [index > 0] 1201 whileTrue: 1202 [newObject basicAt: index put: (self basicAt: index). 1203 index _ index - 1]] 1204 ifFalse: [newObject _ class basicNew]. 1205 index _ class instSize. 1206 [index > 0] 1207 whileTrue: 1208 [newObject instVarAt: index put: (self instVarAt: index). 1209 index _ index - 1]. 1210 ^ newObject! ! 1211 1212!Object methodsFor: 'copying' stamp: 'tk 3/11/2003 13:58'! 1213veryDeepCopy 1214 "Do a complete tree copy using a dictionary. An object in the tree twice is only copied once. All references to the object in the copy of the tree will point to the new copy." 1215 1216 | copier new | 1217 copier _ DeepCopier new initialize: self initialDeepCopierSize. 1218 new _ self veryDeepCopyWith: copier. 1219 copier mapUniClasses. 1220 copier references associationsDo: [:assoc | 1221 assoc value veryDeepFixupWith: copier]. 1222 copier fixDependents. 1223 ^ new! ! 1224 1225!Object methodsFor: 'copying' stamp: 'tk 3/11/2003 13:58'! 1226veryDeepCopySibling 1227 "Do a complete tree copy using a dictionary. Substitute a clone of oldPlayer for the root. Normally, a Player or non systemDefined object would have a new class. We do not want one this time. An object in the tree twice, is only copied once. All references to the object in the copy of the tree will point to the new copy." 1228 1229 | copier new | 1230 copier _ DeepCopier new initialize: self initialDeepCopierSize. 1231 copier newUniClasses: false. 1232 new _ self veryDeepCopyWith: copier. 1233 copier mapUniClasses. 1234 copier references associationsDo: [:assoc | 1235 assoc value veryDeepFixupWith: copier]. 1236 copier fixDependents. 1237 ^ new! ! 1238 1239!Object methodsFor: 'copying' stamp: 'tk 5/13/2003 19:39'! 1240veryDeepCopyUsing: copier 1241 "Do a complete tree copy using a dictionary. An object in the tree twice is only copied once. All references to the object in the copy of the tree will point to the new copy. 1242 Same as veryDeepCopy except copier (with dictionary) is supplied. 1243 ** do not delete this method, even if it has no callers **" 1244 1245 | new refs newDep newModel | 1246 new _ self veryDeepCopyWith: copier. 1247 copier mapUniClasses. 1248 copier references associationsDo: [:assoc | 1249 assoc value veryDeepFixupWith: copier]. 1250 "Fix dependents" 1251 refs _ copier references. 1252 DependentsFields associationsDo: [:pair | 1253 pair value do: [:dep | 1254 (newDep _ refs at: dep ifAbsent: [nil]) ifNotNil: [ 1255 newModel _ refs at: pair key ifAbsent: [pair key]. 1256 newModel addDependent: newDep]]]. 1257 ^ new! ! 1258 1259!Object methodsFor: 'copying' stamp: 'tk 3/11/2003 14:12'! 1260veryDeepCopyWith: deepCopier 1261 "Copy me and the entire tree of objects I point to. An object in the tree twice is copied once, and both references point to him. deepCopier holds a dictionary of objects we have seen. Some classes refuse to be copied. Some classes are picky about which fields get deep copied." 1262 | class index sub subAss new uc sup has mine | 1263 deepCopier references at: self ifPresent: [:newer | ^ newer]. "already did him" 1264 class _ self class. 1265 class isMeta ifTrue: [^ self]. "a class" 1266 new _ self clone. 1267 (class isSystemDefined not and: [deepCopier newUniClasses "allowed"]) ifTrue: [ 1268 uc _ deepCopier uniClasses at: class ifAbsent: [nil]. 1269 uc ifNil: [ 1270 deepCopier uniClasses at: class put: (uc _ self copyUniClassWith: deepCopier). 1271 deepCopier references at: class put: uc]. "remember" 1272 new _ uc new. 1273 new copyFrom: self]. "copy inst vars in case any are weak" 1274 deepCopier references at: self put: new. "remember" 1275 (class isVariable and: [class isPointers]) ifTrue: 1276 [index _ self basicSize. 1277 [index > 0] whileTrue: 1278 [sub _ self basicAt: index. 1279 (subAss _ deepCopier references associationAt: sub ifAbsent: [nil]) 1280 ifNil: [new basicAt: index put: (sub veryDeepCopyWith: deepCopier)] 1281 ifNotNil: [new basicAt: index put: subAss value]. 1282 index _ index - 1]]. 1283 "Ask each superclass if it wants to share (weak copy) any inst vars" 1284 new veryDeepInner: deepCopier. "does super a lot" 1285 1286 "other superclasses want all inst vars deep copied" 1287 sup _ class. index _ class instSize. 1288 [has _ sup compiledMethodAt: #veryDeepInner: ifAbsent: [nil]. 1289 has _ has ifNil: [class isSystemDefined not "is a uniClass"] ifNotNil: [true]. 1290 mine _ sup instVarNames. 1291 has ifTrue: [index _ index - mine size] "skip inst vars" 1292 ifFalse: [1 to: mine size do: [:xx | 1293 sub _ self instVarAt: index. 1294 (subAss _ deepCopier references associationAt: sub ifAbsent: [nil]) 1295 "use association, not value, so nil is an exceptional value" 1296 ifNil: [new instVarAt: index put: 1297 (sub veryDeepCopyWith: deepCopier)] 1298 ifNotNil: [new instVarAt: index put: subAss value]. 1299 index _ index - 1]]. 1300 (sup _ sup superclass) == nil] whileFalse. 1301 new rehash. "force Sets and Dictionaries to rehash" 1302 ^ new 1303! ! 1304 1305!Object methodsFor: 'copying' stamp: 'tk 1/6/1999 17:39'! 1306veryDeepFixupWith: deepCopier 1307 "I have no fields and no superclass. Catch the super call." 1308! ! 1309 1310!Object methodsFor: 'copying' stamp: 'tk 9/4/2001 10:30'! 1311veryDeepInner: deepCopier 1312 "No special treatment for inst vars of my superclasses. Override when some need to be weakly copied. Object>>veryDeepCopyWith: will veryDeepCopy any inst var whose class does not actually define veryDeepInner:" 1313! ! 1314 1315 1316!Object methodsFor: 'creation' stamp: 'nk 2/26/2004 13:35'! 1317asStringMorph 1318 "Open a StringMorph, as best one can, on the receiver" 1319 1320 ^ self asStringOrText asStringMorph 1321! ! 1322 1323!Object methodsFor: 'creation' stamp: 'nk 2/26/2004 13:35'! 1324asTextMorph 1325 "Open a TextMorph, as best one can, on the receiver" 1326 1327 ^ TextMorph new contentsAsIs: self asStringOrText 1328! ! 1329 1330!Object methodsFor: 'creation' stamp: 'sw 1/29/2002 21:45'! 1331openAsMorph 1332 "Open a morph, as best one can, on the receiver" 1333 1334 ^ self asMorph openInHand 1335 1336" 1337234 openAsMorph 1338(ScriptingSystem formAtKey: #TinyMenu) openAsMorph 1339'fred' openAsMorph 1340"! ! 1341 1342 1343!Object methodsFor: 'debugging' stamp: 'md 11/24/2004 11:45'! 1344haltIf: condition 1345 "This is the typical message to use for inserting breakpoints during 1346 debugging. Param can be a block or expression, halt if true. 1347 If the Block has one arg, the receiver is bound to that. 1348 If the condition is a selector, we look up in the callchain. Halt if 1349 any method's selector equals selector." 1350 | cntxt | 1351 1352 condition isSymbol ifTrue:[ 1353 "only halt if a method with selector symbol is in callchain" 1354 cntxt := thisContext. 1355 [cntxt sender isNil] whileFalse: [ 1356 cntxt := cntxt sender. 1357 (cntxt selector = condition) ifTrue: [Halt signal]. 1358 ]. 1359 ^self. 1360 ]. 1361 (condition isBlock 1362 ifTrue: [condition valueWithPossibleArgument: self] 1363 ifFalse: [condition] 1364 ) ifTrue: [ 1365 Halt signal 1366 ].! ! 1367 1368!Object methodsFor: 'debugging'! 1369needsWork! ! 1370 1371 1372!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:26'! 1373checkHaltCountExpired 1374 | counter | 1375 counter _ Smalltalk at: #HaltCount ifAbsent: [0]. 1376 ^counter = 0! ! 1377 1378!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'! 1379clearHaltOnce 1380 "Turn on the halt once flag." 1381 Smalltalk at: #HaltOnce put: false! ! 1382 1383!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:30'! 1384decrementAndCheckHaltCount 1385 self decrementHaltCount. 1386 ^self checkHaltCountExpired! ! 1387 1388!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:28'! 1389decrementHaltCount 1390 | counter | 1391 counter := Smalltalk 1392 at: #HaltCount 1393 ifAbsent: [0]. 1394 counter > 0 ifTrue: [ 1395 counter _ counter - 1. 1396 self setHaltCountTo: counter]! ! 1397 1398!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:42'! 1399doExpiredHaltCount 1400 self clearHaltOnce. 1401 self removeHaltCount. 1402 self halt! ! 1403 1404!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:44'! 1405doExpiredHaltCount: aString 1406 self clearHaltOnce. 1407 self removeHaltCount. 1408 self halt: aString! ! 1409 1410!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:45'! 1411doExpiredInspectCount 1412 self clearHaltOnce. 1413 self removeHaltCount. 1414 self inspect! ! 1415 1416!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:43'! 1417haltOnCount: int 1418 self haltOnceEnabled 1419 ifTrue: [self hasHaltCount 1420 ifTrue: [self decrementAndCheckHaltCount 1421 ifTrue: [self doExpiredHaltCount]] 1422 ifFalse: [int = 1 1423 ifTrue: [self doExpiredHaltCount] 1424 ifFalse: [self setHaltCountTo: int - 1]]]! ! 1425 1426!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:05'! 1427haltOnce 1428 "Halt unless we have already done it once." 1429 self haltOnceEnabled 1430 ifTrue: [self clearHaltOnce. 1431 ^ self halt]! ! 1432 1433!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'! 1434haltOnceEnabled 1435 ^ Smalltalk 1436 at: #HaltOnce 1437 ifAbsent: [false]! ! 1438 1439!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:05'! 1440haltOnce: aString 1441 "Halt unless we have already done it once." 1442 self haltOnceEnabled 1443 ifTrue: [self clearHaltOnce. 1444 ^ self halt: aString]! ! 1445 1446!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:45'! 1447halt: aString onCount: int 1448 self haltOnceEnabled 1449 ifTrue: [self hasHaltCount 1450 ifTrue: [self decrementAndCheckHaltCount 1451 ifTrue: [self doExpiredHaltCount: aString]] 1452 ifFalse: [int = 1 1453 ifTrue: [self doExpiredHaltCount: aString] 1454 ifFalse: [self setHaltCountTo: int - 1]]]! ! 1455 1456!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:36'! 1457hasHaltCount 1458 ^Smalltalk 1459 includesKey: #HaltCount! ! 1460 1461!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:46'! 1462inspectOnCount: int 1463 self haltOnceEnabled 1464 ifTrue: [self hasHaltCount 1465 ifTrue: [self decrementAndCheckHaltCount 1466 ifTrue: [self doExpiredInspectCount]] 1467 ifFalse: [int = 1 1468 ifTrue: [self doExpiredInspectCount] 1469 ifFalse: [self setHaltCountTo: int - 1]]]! ! 1470 1471!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:05'! 1472inspectOnce 1473 "Inspect unless we have already done it once." 1474 self haltOnceEnabled 1475 ifTrue: [self clearHaltOnce. 1476 ^ self inspect]! ! 1477 1478!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 13:20'! 1479inspectUntilCount: int 1480 self haltOnceEnabled 1481 ifTrue: [self hasHaltCount 1482 ifTrue: [self decrementAndCheckHaltCount 1483 ifTrue: [self doExpiredInspectCount] 1484 ifFalse: [self inspect]] 1485 ifFalse: [int = 1 1486 ifTrue: [self doExpiredInspectCount] 1487 ifFalse: [self setHaltCountTo: int - 1]]]! ! 1488 1489!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:49'! 1490removeHaltCount 1491 (Smalltalk includesKey: #HaltCount) ifTrue: [ 1492 Smalltalk removeKey: #HaltCount]! ! 1493 1494!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 6/2/2004 08:25'! 1495setHaltCountTo: int 1496 Smalltalk at: #HaltCount put: int! ! 1497 1498!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'! 1499setHaltOnce 1500 "Turn on the halt once flag." 1501 Smalltalk at: #HaltOnce put: true! ! 1502 1503!Object methodsFor: 'debugging-haltOnce' stamp: 'sbw 5/19/2004 19:04'! 1504toggleHaltOnce 1505 self haltOnceEnabled 1506 ifTrue: [self clearHaltOnce] 1507 ifFalse: [self setHaltOnce]! ! 1508 1509 1510!Object methodsFor: 'dependents access' stamp: 'ar 2/11/2001 01:55'! 1511addDependent: anObject 1512 "Make the given object one of the receiver's dependents." 1513 1514 | dependents | 1515 dependents _ self dependents. 1516 (dependents includes: anObject) ifFalse: 1517 [self myDependents: (dependents copyWithDependent: anObject)]. 1518 ^ anObject! ! 1519 1520!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:53'! 1521breakDependents 1522 "Remove all of the receiver's dependents." 1523 1524 self myDependents: nil! ! 1525 1526!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:26'! 1527canDiscardEdits 1528 "Answer true if none of the views on this model has unaccepted edits that matter." 1529 1530 self dependents 1531 do: [:each | each canDiscardEdits ifFalse: [^ false]] 1532 without: self. 1533 ^ true! ! 1534 1535!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:58'! 1536dependents 1537 "Answer a collection of objects that are 'dependent' on the receiver; 1538 that is, all objects that should be notified if the receiver changes." 1539 1540 ^ self myDependents ifNil: [#()]! ! 1541 1542!Object methodsFor: 'dependents access'! 1543evaluate: actionBlock wheneverChangeIn: aspectBlock 1544 | viewerThenObject objectThenViewer | 1545 objectThenViewer _ self. 1546 viewerThenObject _ ObjectViewer on: objectThenViewer. 1547 objectThenViewer become: viewerThenObject. 1548 "--- Then ---" 1549 objectThenViewer xxxViewedObject: viewerThenObject 1550 evaluate: actionBlock 1551 wheneverChangeIn: aspectBlock! ! 1552 1553!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:59'! 1554hasUnacceptedEdits 1555 "Answer true if any of the views on this object has unaccepted edits." 1556 1557 self dependents 1558 do: [:each | each hasUnacceptedEdits ifTrue: [^ true]] 1559 without: self. 1560 ^ false! ! 1561 1562!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:55'! 1563myDependents 1564 "Private. Answer a list of all the receiver's dependents." 1565 1566 ^ DependentsFields at: self ifAbsent: []! ! 1567 1568!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 19:52'! 1569myDependents: aCollectionOrNil 1570 "Private. Set (or remove) the receiver's dependents list." 1571 1572 aCollectionOrNil 1573 ifNil: [DependentsFields removeKey: self ifAbsent: []] 1574 ifNotNil: [DependentsFields at: self put: aCollectionOrNil]! ! 1575 1576!Object methodsFor: 'dependents access' stamp: 'reThink 2/18/2001 17:06'! 1577release 1578 "Remove references to objects that may refer to the receiver. This message 1579 should be overridden by subclasses with any cycles, in which case the 1580 subclass should also include the expression super release." 1581 1582 self releaseActionMap! ! 1583 1584!Object methodsFor: 'dependents access' stamp: 'sma 2/29/2000 20:23'! 1585removeDependent: anObject 1586 "Remove the given object as one of the receiver's dependents." 1587 1588 | dependents | 1589 dependents _ self dependents reject: [:each | each == anObject]. 1590 self myDependents: (dependents isEmpty ifFalse: [dependents]). 1591 ^ anObject! ! 1592 1593 1594!Object methodsFor: 'drag and drop' stamp: 'bh 9/16/2001 18:10'! 1595acceptDroppingMorph: transferMorph event: evt inMorph: dstListMorph 1596 1597 ^false.! ! 1598 1599!Object methodsFor: 'drag and drop' stamp: 'mir 5/16/2000 11:35'! 1600dragAnimationFor: item transferMorph: transferMorph 1601 "Default do nothing"! ! 1602 1603!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:20'! 1604dragPassengerFor: item inMorph: dragSource 1605 ^item! ! 1606 1607!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:11'! 1608dragTransferType 1609 ^nil! ! 1610 1611!Object methodsFor: 'drag and drop' stamp: 'panda 4/28/2000 16:05'! 1612dragTransferTypeForMorph: dragSource 1613 ^nil! ! 1614 1615!Object methodsFor: 'drag and drop' stamp: 'mir 5/8/2000 17:19'! 1616wantsDroppedMorph: aMorph event: anEvent inMorph: destinationLM 1617 ^false! ! 1618 1619 1620!Object methodsFor: 'error handling' stamp: 'sma 5/6/2000 19:35'! 1621assert: aBlock 1622 "Throw an assertion error if aBlock does not evaluates to true." 1623 1624 aBlock value ifFalse: [AssertionFailure signal: 'Assertion failed']! ! 1625 1626!Object methodsFor: 'error handling' stamp: 'nk 1/15/2004 10:54'! 1627assert: aBlock descriptionBlock: descriptionBlock 1628 "Throw an assertion error if aBlock does not evaluate to true." 1629 1630 aBlock value ifFalse: [AssertionFailure signal: descriptionBlock value asString ]! ! 1631 1632!Object methodsFor: 'error handling' stamp: 'nk 10/25/2003 16:47'! 1633assert: aBlock description: aString 1634 "Throw an assertion error if aBlock does not evaluates to true." 1635 1636 aBlock value ifFalse: [AssertionFailure signal: aString ]! ! 1637 1638!Object methodsFor: 'error handling' stamp: 'md 10/13/2004 15:59'! 1639backwardCompatibilityOnly: anExplanationString 1640 "Warn that the sending method has been deprecated. Methods that are tagt with #backwardCompatibility: 1641 are kept for compatibility." 1642 1643 Preferences showDeprecationWarnings ifTrue: 1644 [Deprecation signal: thisContext sender printString, ' has been deprecated (but will be kept for compatibility). ', anExplanationString]! ! 1645 1646!Object methodsFor: 'error handling'! 1647caseError 1648 "Report an error from an in-line or explicit case statement." 1649 1650 self error: 'Case not found, and no otherwise clause'! ! 1651 1652!Object methodsFor: 'error handling' stamp: 'rbb 3/1/2005 09:26'! 1653confirm: queryString 1654 "Put up a yes/no menu with caption queryString. Answer true if the 1655 response is yes, false if no. This is a modal question--the user must 1656 respond yes or no." 1657 1658 "nil confirm: 'Are you hungry?'" 1659 1660 ^ UIManager default confirm: queryString! ! 1661 1662!Object methodsFor: 'error handling' stamp: 'rbb 3/1/2005 09:27'! 1663confirm: aString orCancel: cancelBlock 1664 "Put up a yes/no/cancel menu with caption aString. Answer true if 1665 the response is yes, false if no. If cancel is chosen, evaluate 1666 cancelBlock. This is a modal question--the user must respond yes or no." 1667 1668 ^ UIManager default confirm: aString orCancel: cancelBlock! ! 1669 1670!Object methodsFor: 'error handling' stamp: 'dew 10/6/2003 18:20'! 1671deprecated: anExplanationString 1672 "Warn that the sending method has been deprecated." 1673 1674 Preferences showDeprecationWarnings ifTrue: 1675 [Deprecation signal: thisContext sender printString, ' has been deprecated. ', anExplanationString]! ! 1676 1677!Object methodsFor: 'error handling' stamp: 'dew 10/7/2003 00:26'! 1678deprecated: anExplanationString block: aBlock 1679 "Warn that the sender has been deprecated. Answer the value of aBlock on resumption. (Note that #deprecated: is usually the preferred method.)" 1680 1681 Preferences showDeprecationWarnings ifTrue: 1682 [Deprecation 1683 signal: thisContext sender printString, ' has been deprecated. ', anExplanationString]. 1684 ^ aBlock value. 1685! ! 1686 1687!Object methodsFor: 'error handling' stamp: 'md 2/22/2006 21:21'! 1688doesNotUnderstand: aMessage 1689 "Handle the fact that there was an attempt to send the given message to the receiver but the receiver does not understand this message (typically sent from the machine when a message is sent to the receiver and no method is defined for that selector)." 1690 "Testing: (3 activeProcess)" 1691 1692 MessageNotUnderstood new 1693 message: aMessage; 1694 receiver: self; 1695 signal. 1696 ^ aMessage sentTo: self. 1697! ! 1698 1699!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 16:47'! 1700dpsTrace: reportObject 1701 Transcript myDependents isNil ifTrue: [^self]. 1702 self dpsTrace: reportObject levels: 1 withContext: thisContext 1703 1704" nil dpsTrace: 'sludder'. "! ! 1705 1706!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 16:49'! 1707dpsTrace: reportObject levels: anInt 1708 self dpsTrace: reportObject levels: anInt withContext: thisContext 1709 1710"(1 to: 3) do: [:int | nil dpsTrace: int levels: 5.]"! ! 1711 1712!Object methodsFor: 'error handling' stamp: 'TRee 11/4/2003 17:02'! 1713dpsTrace: reportObject levels: anInt withContext: currentContext 1714 | reportString context displayCount | 1715 reportString := (reportObject respondsTo: #asString) 1716 ifTrue: [reportObject asString] ifFalse: [reportObject printString]. 1717 (Smalltalk at: #Decompiler ifAbsent: [nil]) 1718 ifNil: 1719 [Transcript cr; show: reportString] 1720 ifNotNil: 1721 [context := currentContext. 1722 displayCount := anInt > 1. 1723 1 to: anInt do: 1724 [:count | 1725 Transcript cr. 1726 displayCount 1727 ifTrue: [Transcript show: count printString, ': ']. 1728 1729 reportString notNil 1730 ifTrue: 1731 [Transcript show: context home class name 1732 , '/' , context sender selector, ' (' , reportString , ')'. 1733 context := context sender. 1734 reportString := nil] 1735 ifFalse: 1736 [(context notNil and: [(context := context sender) notNil]) 1737 ifTrue: [Transcript show: context receiver class name , '/' , context selector]]]. 1738 "Transcript cr"].! ! 1739 1740!Object methodsFor: 'error handling' stamp: 'md 8/2/2005 22:17'! 1741error 1742 "Throw a generic Error exception." 1743 1744 ^self error: 'Error!!'.! ! 1745 1746!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:55'! 1747error: aString 1748 "Throw a generic Error exception." 1749 1750 ^Error new signal: aString! ! 1751 1752!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'! 1753explicitRequirement 1754 self error: 'Explicitly required method'! ! 1755 1756!Object methodsFor: 'error handling' stamp: 'al 2/13/2006 22:20'! 1757halt 1758 "This is the typical message to use for inserting breakpoints during 1759 debugging. It behaves like halt:, but does not call on halt: in order to 1760 avoid putting this message on the stack. Halt is especially useful when 1761 the breakpoint message is an arbitrary one." 1762 1763 Halt signal! ! 1764 1765!Object methodsFor: 'error handling' stamp: 'tfei 4/12/1999 12:59'! 1766halt: aString 1767 "This is the typical message to use for inserting breakpoints during 1768 debugging. It creates and schedules a Notifier with the argument, 1769 aString, as the label." 1770 1771 Halt new signal: aString! ! 1772 1773!Object methodsFor: 'error handling' stamp: 'md 1/20/2006 16:24'! 1774handles: exception 1775 "This method exists in case a non exception class is the first arg in an on:do: (for instance using a exception class that is not loaded). We prefer this to raising an error during error handling itself. Also, semantically it makes sense that the exception handler is not active if its exception class is not loaded" 1776 1777 ^ false! ! 1778 1779!Object methodsFor: 'error handling' stamp: 'ar 9/27/2005 20:24'! 1780notifyWithLabel: aString 1781 "Create and schedule a Notifier with aString as the window label as well as the contents of the window, in order to request confirmation before a process can proceed." 1782 1783 ToolSet 1784 debugContext: thisContext 1785 label: aString 1786 contents: aString 1787 1788 "nil notifyWithLabel: 'let us see if this works'"! ! 1789 1790!Object methodsFor: 'error handling' stamp: 'hg 10/2/2001 20:49'! 1791notify: aString 1792 "Create and schedule a Notifier with the argument as the message in 1793 order to request confirmation before a process can proceed." 1794 1795 Warning signal: aString 1796 1797 "nil notify: 'confirmation message'"! ! 1798 1799!Object methodsFor: 'error handling'! 1800notify: aString at: location 1801 "Create and schedule a Notifier with the argument as the message in 1802 order to request confirmation before a process can proceed. Subclasses can 1803 override this and insert an error message at location within aString." 1804 1805 self notify: aString 1806 1807 "nil notify: 'confirmation message' at: 12"! ! 1808 1809!Object methodsFor: 'error handling'! 1810primitiveFailed 1811 "Announce that a primitive has failed and there is no appropriate 1812 Smalltalk code to run." 1813 1814 self error: 'a primitive has failed'! ! 1815 1816!Object methodsFor: 'error handling' stamp: 'al 9/16/2005 14:12'! 1817requirement 1818 self error: 'Implicitly required method'! ! 1819 1820!Object methodsFor: 'error handling' stamp: 'AFi 2/8/2003 22:52'! 1821shouldBeImplemented 1822 "Announce that this message should be implemented" 1823 1824 self error: 'This message should be implemented'! ! 1825 1826!Object methodsFor: 'error handling'! 1827shouldNotImplement 1828 "Announce that, although the receiver inherits this message, it should 1829 not implement it." 1830 1831 self error: 'This message is not appropriate for this object'! ! 1832 1833!Object methodsFor: 'error handling' stamp: 'md 2/17/2006 12:02'! 1834subclassResponsibility 1835 "This message sets up a framework for the behavior of the class' subclasses. 1836 Announce that the subclass should have implemented this message." 1837 1838 self error: 'My subclass should have overridden ', thisContext sender selector printString! ! 1839 1840!Object methodsFor: 'error handling' stamp: 'al 12/16/2003 16:16'! 1841traitConflict 1842 self error: 'A class or trait does not properly resolve a conflict between multiple traits it uses.'! ! 1843 1844 1845!Object methodsFor: 'evaluating' stamp: 'reThink 3/12/2001 18:14'! 1846value 1847 1848 ^self! ! 1849 1850!Object methodsFor: 'evaluating' stamp: 'reThink 2/18/2001 15:23'! 1851valueWithArguments: aSequenceOfArguments 1852 1853 ^self! ! 1854 1855 1856!Object methodsFor: 'events' stamp: 'nk 8/27/2003 16:23'! 1857actionsWithReceiver: anObject forEvent: anEventSelector 1858 1859 ^(self actionSequenceForEvent: anEventSelector) 1860 select: [:anAction | anAction receiver == anObject ]! ! 1861 1862!Object methodsFor: 'events' stamp: 'nk 8/27/2003 17:45'! 1863renameActionsWithReceiver: anObject forEvent: anEventSelector toEvent: newEvent 1864 1865 | oldActions newActions | 1866 oldActions _ Set new. 1867 newActions _ Set new. 1868 (self actionSequenceForEvent: anEventSelector) do: [ :action | 1869 action receiver == anObject 1870 ifTrue: [ oldActions add: anObject ] 1871 ifFalse: [ newActions add: anObject ]]. 1872 self setActionSequence: (ActionSequence withAll: newActions) forEvent: anEventSelector. 1873 oldActions do: [ :act | self when: newEvent evaluate: act ].! ! 1874 1875 1876!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'! 1877actionForEvent: anEventSelector 1878 "Answer the action to be evaluated when <anEventSelector> has been triggered." 1879 1880 | actions | 1881 actions := self actionMap 1882 at: anEventSelector asSymbol 1883 ifAbsent: [nil]. 1884 actions ifNil: [^nil]. 1885 ^ actions asMinimalRepresentation! ! 1886 1887!Object methodsFor: 'events-accessing' stamp: 'nk 12/20/2002 17:48'! 1888actionForEvent: anEventSelector 1889ifAbsent: anExceptionBlock 1890 "Answer the action to be evaluated when <anEventSelector> has been triggered." 1891 1892 | actions | 1893 actions := self actionMap 1894 at: anEventSelector asSymbol 1895 ifAbsent: [nil]. 1896 actions ifNil: [^anExceptionBlock value]. 1897 ^ actions asMinimalRepresentation! ! 1898 1899!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 14:43'! 1900actionMap 1901 1902 ^EventManager actionMapFor: self! ! 1903 1904!Object methodsFor: 'events-accessing' stamp: 'rw 4/27/2002 08:35'! 1905actionSequenceForEvent: anEventSelector 1906 1907 ^(self actionMap 1908 at: anEventSelector asSymbol 1909 ifAbsent: [^WeakActionSequence new]) 1910 asActionSequence! ! 1911 1912!Object methodsFor: 'events-accessing' stamp: 'SqR 6/28/2001 13:19'! 1913actionsDo: aBlock 1914 1915 self actionMap do: aBlock! ! 1916 1917!Object methodsFor: 'events-accessing' stamp: 'rw 2/10/2002 13:05'! 1918createActionMap 1919 1920 ^IdentityDictionary new! ! 1921 1922!Object methodsFor: 'events-accessing' stamp: 'SqR 2/19/2001 14:04'! 1923hasActionForEvent: anEventSelector 1924 "Answer true if there is an action associated with anEventSelector" 1925 1926 ^(self actionForEvent: anEventSelector) notNil! ! 1927 1928!Object methodsFor: 'events-accessing' stamp: 'reThink 2/18/2001 15:29'! 1929setActionSequence: actionSequence 1930forEvent: anEventSelector 1931 1932 | action | 1933 action := actionSequence asMinimalRepresentation. 1934 action == nil 1935 ifTrue: 1936 [self removeActionsForEvent: anEventSelector] 1937 ifFalse: 1938 [self updateableActionMap 1939 at: anEventSelector asSymbol 1940 put: action]! ! 1941 1942!Object methodsFor: 'events-accessing' stamp: 'reThink 2/25/2001 08:50'! 1943updateableActionMap 1944 1945 ^EventManager updateableActionMapFor: self! ! 1946 1947 1948!Object methodsFor: 'events-registering' stamp: 'reThink 2/18/2001 15:04'! 1949when: anEventSelector evaluate: anAction 1950 1951 | actions | 1952 actions := self actionSequenceForEvent: anEventSelector. 1953 (actions includes: anAction) 1954 ifTrue: [^ self]. 1955 self 1956 setActionSequence: (actions copyWith: anAction) 1957 forEvent: anEventSelector! ! 1958 1959!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'! 1960when: anEventSelector 1961send: aMessageSelector 1962to: anObject 1963 1964 self 1965 when: anEventSelector 1966 evaluate: (WeakMessageSend 1967 receiver: anObject 1968 selector: aMessageSelector)! ! 1969 1970!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'! 1971when: anEventSelector 1972send: aMessageSelector 1973to: anObject 1974withArguments: anArgArray 1975 1976 self 1977 when: anEventSelector 1978 evaluate: (WeakMessageSend 1979 receiver: anObject 1980 selector: aMessageSelector 1981 arguments: anArgArray)! ! 1982 1983!Object methodsFor: 'events-registering' stamp: 'rww 12/30/2002 10:37'! 1984when: anEventSelector 1985send: aMessageSelector 1986to: anObject 1987with: anArg 1988 1989 self 1990 when: anEventSelector 1991 evaluate: (WeakMessageSend 1992 receiver: anObject 1993 selector: aMessageSelector 1994 arguments: (Array with: anArg))! ! 1995 1996 1997!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'! 1998releaseActionMap 1999 2000 EventManager releaseActionMapFor: self! ! 2001 2002!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:33'! 2003removeActionsForEvent: anEventSelector 2004 2005 | map | 2006 map := self actionMap. 2007 map removeKey: anEventSelector asSymbol ifAbsent: []. 2008 map isEmpty 2009 ifTrue: [self releaseActionMap]! ! 2010 2011!Object methodsFor: 'events-removing' stamp: 'nk 8/25/2003 21:46'! 2012removeActionsSatisfying: aBlock 2013 2014 self actionMap keys do: 2015 [:eachEventSelector | 2016 self 2017 removeActionsSatisfying: aBlock 2018 forEvent: eachEventSelector 2019 ]! ! 2020 2021!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'! 2022removeActionsSatisfying: aOneArgBlock 2023forEvent: anEventSelector 2024 2025 self 2026 setActionSequence: 2027 ((self actionSequenceForEvent: anEventSelector) 2028 reject: [:anAction | aOneArgBlock value: anAction]) 2029 forEvent: anEventSelector! ! 2030 2031!Object methodsFor: 'events-removing' stamp: 'rw 7/29/2003 17:18'! 2032removeActionsWithReceiver: anObject 2033 2034 self actionMap copy keysDo: 2035 [:eachEventSelector | 2036 self 2037 removeActionsSatisfying: [:anAction | anAction receiver == anObject] 2038 forEvent: eachEventSelector 2039 ]! ! 2040 2041!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:36'! 2042removeActionsWithReceiver: anObject 2043forEvent: anEventSelector 2044 2045 self 2046 removeActionsSatisfying: 2047 [:anAction | 2048 anAction receiver == anObject] 2049 forEvent: anEventSelector! ! 2050 2051!Object methodsFor: 'events-removing' stamp: 'reThink 2/18/2001 15:31'! 2052removeAction: anAction 2053forEvent: anEventSelector 2054 2055 self 2056 removeActionsSatisfying: [:action | action = anAction] 2057 forEvent: anEventSelector! ! 2058 2059 2060!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:22'! 2061triggerEvent: anEventSelector 2062 "Evaluate all actions registered for <anEventSelector>. Return the value of the last registered action." 2063 2064 ^(self actionForEvent: anEventSelector) value! ! 2065 2066!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 17:09'! 2067triggerEvent: anEventSelector 2068ifNotHandled: anExceptionBlock 2069 "Evaluate all actions registered for <anEventSelector>. Return the value of the last registered action." 2070 2071 ^(self 2072 actionForEvent: anEventSelector 2073 ifAbsent: [^anExceptionBlock value]) value 2074! ! 2075 2076!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:21'! 2077triggerEvent: anEventSelector 2078withArguments: anArgumentList 2079 2080 ^(self actionForEvent: anEventSelector) 2081 valueWithArguments: anArgumentList! ! 2082 2083!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 15:21'! 2084triggerEvent: anEventSelector 2085withArguments: anArgumentList 2086ifNotHandled: anExceptionBlock 2087 2088 ^(self 2089 actionForEvent: anEventSelector 2090 ifAbsent: [^anExceptionBlock value]) 2091 valueWithArguments: anArgumentList! ! 2092 2093!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 14:59'! 2094triggerEvent: anEventSelector 2095with: anObject 2096 2097 ^self 2098 triggerEvent: anEventSelector 2099 withArguments: (Array with: anObject)! ! 2100 2101!Object methodsFor: 'events-triggering' stamp: 'reThink 2/18/2001 14:59'! 2102triggerEvent: anEventSelector 2103with: anObject 2104ifNotHandled: anExceptionBlock 2105 2106 ^self 2107 triggerEvent: anEventSelector 2108 withArguments: (Array with: anObject) 2109 ifNotHandled: anExceptionBlock! ! 2110 2111 2112!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:42'! 2113byteEncode:aStream 2114 self flattenOnStream:aStream. 2115! ! 2116 2117!Object methodsFor: 'filter streaming'! 2118drawOnCanvas:aStream 2119 self flattenOnStream:aStream. 2120! ! 2121 2122!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 01:31'! 2123elementSeparator 2124 ^nil.! ! 2125 2126!Object methodsFor: 'filter streaming'! 2127encodePostscriptOn:aStream 2128 self byteEncode:aStream. 2129! ! 2130 2131!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:07'! 2132flattenOnStream:aStream 2133 self writeOnFilterStream:aStream. 2134! ! 2135 2136!Object methodsFor: 'filter streaming' stamp: 'mpw 6/22/1930 22:56'! 2137fullDrawPostscriptOn:aStream 2138 ^aStream fullDraw:self. 2139! ! 2140 2141!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 01:51'! 2142printOnStream:aStream 2143 self byteEncode:aStream. 2144! ! 2145 2146!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:49'! 2147putOn:aStream 2148 ^aStream nextPut:self. 2149! ! 2150 2151!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 01:53'! 2152storeOnStream:aStream 2153 self printOnStream:aStream. 2154! ! 2155 2156!Object methodsFor: 'filter streaming' stamp: 'MPW 1/1/1901 00:06'! 2157writeOnFilterStream:aStream 2158 aStream writeObject:self. 2159! ! 2160 2161 2162!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 16:26'! 2163actAsExecutor 2164 "Prepare the receiver to act as executor for any resources associated with it" 2165 self breakDependents! ! 2166 2167!Object methodsFor: 'finalization' stamp: 'ar 3/20/98 22:19'! 2168executor 2169 "Return an object which can act as executor for finalization of the receiver" 2170 ^self shallowCopy actAsExecutor! ! 2171 2172!Object methodsFor: 'finalization' stamp: 'ar 5/19/2003 20:10'! 2173finalizationRegistry 2174 "Answer the finalization registry associated with the receiver." 2175 ^WeakRegistry default! ! 2176 2177!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 16:27'! 2178finalize 2179 "Finalize the resource associated with the receiver. This message should only be sent during the finalization process. There is NO garantuee that the resource associated with the receiver hasn't been free'd before so take care that you don't run into trouble - this all may happen with interrupt priority."! ! 2180 2181!Object methodsFor: 'finalization' stamp: 'ar 3/21/98 18:38'! 2182retryWithGC: execBlock until: testBlock 2183 "Retry execBlock as long as testBlock returns false. Do an incremental GC after the first try, a full GC after the second try." 2184 | blockValue | 2185 blockValue := execBlock value. 2186 (testBlock value: blockValue) ifTrue:[^blockValue]. 2187 Smalltalk garbageCollectMost. 2188 blockValue := execBlock value. 2189 (testBlock value: blockValue) ifTrue:[^blockValue]. 2190 Smalltalk garbageCollect. 2191 ^execBlock value.! ! 2192 2193!Object methodsFor: 'finalization' stamp: 'ar 5/19/2003 20:14'! 2194toFinalizeSend: aSelector to: aFinalizer with: aResourceHandle 2195 "When I am finalized (e.g., garbage collected) close the associated resource handle by sending aSelector to the appropriate finalizer (the guy who knows how to get rid of the resource). 2196 WARNING: Neither the finalizer nor the resource handle are allowed to reference me. If they do, then I will NEVER be garbage collected. Since this cannot be validated here, it is up to the client to make sure this invariant is not broken." 2197 self == aFinalizer ifTrue:[self error: 'I cannot finalize myself']. 2198 self == aResourceHandle ifTrue:[self error: 'I cannot finalize myself']. 2199 ^self finalizationRegistry add: self executor: 2200 (ObjectFinalizer new 2201 receiver: aFinalizer 2202 selector: aSelector 2203 argument: aResourceHandle)! ! 2204 2205 2206!Object methodsFor: 'flagging' stamp: 'sw 8/4/97 16:49'! 2207isThisEverCalled 2208 ^ self isThisEverCalled: thisContext sender printString! ! 2209 2210!Object methodsFor: 'flagging'! 2211isThisEverCalled: msg 2212 "Send this message, with some useful printable argument, from methods or branches of methods which you believe are never reached. 2/5/96 sw" 2213 2214 self halt: 'This is indeed called: ', msg printString! ! 2215 2216!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:23'! 2217logEntry 2218 2219 Transcript show: 'Entered ', thisContext sender printString; cr. 2220! ! 2221 2222!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:23'! 2223logExecution 2224 2225 Transcript show: 'Executing ', thisContext sender printString; cr. 2226! ! 2227 2228!Object methodsFor: 'flagging' stamp: 'jm 3/18/98 17:22'! 2229logExit 2230 2231 Transcript show: 'Exited ', thisContext sender printString; cr. 2232! ! 2233 2234 2235!Object methodsFor: 'graph model' stamp: 'dgd 9/18/2004 15:07'! 2236addModelYellowButtonMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph 2237 "The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items" 2238 Preferences cmdGesturesEnabled ifTrue: [ "build mode" 2239 aCustomMenu add: 'inspect model' translated target: self action: #inspect. 2240 ]. 2241 2242 ^aCustomMenu 2243! ! 2244 2245!Object methodsFor: 'graph model' stamp: 'nk 1/23/2004 14:35'! 2246hasModelYellowButtonMenuItems 2247 ^Preferences cmdGesturesEnabled! ! 2248 2249 2250!Object methodsFor: 'inspecting' stamp: 'ar 9/27/2005 18:31'! 2251basicInspect 2252 "Create and schedule an Inspector in which the user can examine the 2253 receiver's variables. This method should not be overriden." 2254 ^ToolSet basicInspect: self! ! 2255 2256!Object methodsFor: 'inspecting' stamp: 'md 1/18/2006 19:09'! 2257inspect 2258 "Create and schedule an Inspector in which the user can examine the receiver's variables." 2259 ToolSet inspect: self! ! 2260 2261!Object methodsFor: 'inspecting' stamp: 'apb 7/14/2004 12:19'! 2262inspectorClass 2263 "Answer the class of the inspector to be used on the receiver. Called by inspect; 2264 use basicInspect to get a normal (less useful) type of inspector." 2265 2266 ^ Inspector! ! 2267 2268 2269!Object methodsFor: 'locales' stamp: 'tak 8/4/2005 14:55'! 2270localeChanged 2271 self shouldBeImplemented! ! 2272 2273 2274!Object methodsFor: 'macpal' stamp: 'sw 5/7/1998 23:00'! 2275codeStrippedOut: messageString 2276 "When a method is stripped out for external release, it is replaced by a method that calls this" 2277 2278 self halt: 'Code stripped out -- ', messageString, '-- do not proceed.'! ! 2279 2280!Object methodsFor: 'macpal' stamp: 'sw 1/28/1999 17:31'! 2281contentsChanged 2282 self changed: #contents! ! 2283 2284!Object methodsFor: 'macpal' stamp: 'ar 3/18/2001 00:03'! 2285currentEvent 2286 "Answer the current Morphic event. This method never returns nil." 2287 ^ActiveEvent ifNil:[self currentHand lastEvent]! ! 2288 2289!Object methodsFor: 'macpal' stamp: 'nk 9/1/2004 10:41'! 2290currentHand 2291 "Return a usable HandMorph -- the one associated with the object's current environment. This method will always return a hand, even if it has to conjure one up as a last resort. If a particular hand is actually handling events at the moment (such as a remote hand or a ghost hand), it will be returned." 2292 2293 ^ActiveHand ifNil: [ self currentWorld primaryHand ]! ! 2294 2295!Object methodsFor: 'macpal' stamp: 'sw 5/17/2001 12:08'! 2296currentVocabulary 2297 "Answer the currently-prevailing default vocabulary." 2298 2299 ^ Smalltalk isMorphic ifTrue: 2300 [ActiveWorld currentVocabulary] 2301 ifFalse: 2302 [Vocabulary fullVocabulary]! ! 2303 2304!Object methodsFor: 'macpal' stamp: 'ar 3/18/2001 00:08'! 2305currentWorld 2306 "Answer a morphic world that is the current UI focus. 2307 If in an embedded world, it's that world. 2308 If in a morphic project, it's that project's world. 2309 If in an mvc project, it is the topmost morphic-mvc-window's worldMorph. 2310 If in an mvc project that has no morphic-mvc-windows, then it's just some existing worldmorph instance. 2311 If in an mvc project in a Squeak that has NO WorldMorph instances, one is created. 2312 2313 This method will never return nil, it will always return its best effort at returning a relevant world morph, but if need be -- if there are no worlds anywhere, it will create a new one." 2314 2315 | aView aSubview | 2316 ActiveWorld ifNotNil:[^ActiveWorld]. 2317 World ifNotNil:[^World]. 2318 aView _ ScheduledControllers controllerSatisfying: 2319 [:ctrl | (aSubview _ ctrl view firstSubView) notNil and: 2320 [aSubview model isMorph and: [aSubview model isWorldMorph]]]. 2321 ^aView 2322 ifNotNil: 2323 [aSubview model] 2324 ifNil: 2325 [MVCWiWPasteUpMorph newWorldForProject: nil].! ! 2326 2327!Object methodsFor: 'macpal' stamp: 'jm 5/6/1998 22:35'! 2328flash 2329 "Do nothing." 2330! ! 2331 2332!Object methodsFor: 'macpal' stamp: 'sw 6/16/1998 15:07'! 2333instanceVariableValues 2334 "Answer a collection whose elements are the values of those instance variables of the receiver which were added by the receiver's class" 2335 | c | 2336 c _ OrderedCollection new. 2337 self class superclass instSize + 1 to: self class instSize do: 2338 [:i | c add: (self instVarAt: i)]. 2339 ^ c! ! 2340 2341!Object methodsFor: 'macpal' stamp: 'sw 3/20/2001 13:29'! 2342isUniversalTiles 2343 "Return true if I (my world) uses universal tiles. This message can be called in places where the current World is not known, such as when writing out a project. For more information about the project-writing subtlety addressed by this protocol, kindly contact Ted Kaehler." 2344 2345 ^ Preferences universalTiles! ! 2346 2347!Object methodsFor: 'macpal' stamp: 'sw 10/24/2000 07:04'! 2348objectRepresented 2349 "most objects represent themselves; this provides a hook for aliases to grab on to" 2350 2351 ^ self! ! 2352 2353!Object methodsFor: 'macpal' stamp: 'sw 5/22/2001 18:31'! 2354refusesToAcceptCode 2355 "Answer whether the receiver is a code-bearing instrument which at the moment refuses to allow its contents to be submitted" 2356 2357 ^ false 2358 ! ! 2359 2360!Object methodsFor: 'macpal' stamp: 'jm 2/24/1999 12:40'! 2361scriptPerformer 2362 2363 ^ self 2364! ! 2365 2366!Object methodsFor: 'macpal' stamp: 'sw 3/20/2001 13:40'! 2367slotInfo 2368 "Answer a list of slot-information objects. Initally only provides useful info for players" 2369 2370 ^ Dictionary new! ! 2371 2372 2373!Object methodsFor: 'message handling' stamp: 'md 1/20/2006 16:28'! 2374executeMethod: compiledMethod 2375 "Execute compiledMethod against the receiver with no args" 2376 2377 "<primitive: 189>" "uncomment once prim 189 is in VM" 2378 ^ self withArgs: #() executeMethod: compiledMethod! ! 2379 2380!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:52'! 2381perform: aSymbol 2382 "Send the unary selector, aSymbol, to the receiver. 2383 Fail if the number of arguments expected by the selector is not zero. 2384 Primitive. Optional. See Object documentation whatIsAPrimitive." 2385 2386 <primitive: 83> 2387 ^ self perform: aSymbol withArguments: (Array new: 0)! ! 2388 2389!Object methodsFor: 'message handling' stamp: 'st 11/5/2004 16:19'! 2390perform: selector orSendTo: otherTarget 2391 "If I wish to intercept and handle selector myself, do it; else send it to otherTarget" 2392 ^ (self respondsTo: selector) ifTrue: [self perform: selector] ifFalse: [otherTarget perform: selector]! ! 2393 2394!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:55'! 2395perform: selector withArguments: argArray 2396 "Send the selector, aSymbol, to the receiver with arguments in argArray. 2397 Fail if the number of arguments expected by the selector 2398 does not match the size of argArray. 2399 Primitive. Optional. See Object documentation whatIsAPrimitive." 2400 2401 <primitive: 84> 2402 ^ self perform: selector withArguments: argArray inSuperclass: self class! ! 2403 2404!Object methodsFor: 'message handling' stamp: 'ar 4/25/2005 13:35'! 2405perform: selector withArguments: argArray inSuperclass: lookupClass 2406 "NOTE: This is just like perform:withArguments:, except that 2407 the message lookup process begins, not with the receivers's class, 2408 but with the supplied superclass instead. It will fail if lookupClass 2409 cannot be found among the receiver's superclasses. 2410 Primitive. Essential. See Object documentation whatIsAPrimitive." 2411 2412 <primitive: 100> 2413 (selector isSymbol) 2414 ifFalse: [^ self error: 'selector argument must be a Symbol']. 2415 (selector numArgs = argArray size) 2416 ifFalse: [^ self error: 'incorrect number of arguments']. 2417 (self class == lookupClass or: [self class inheritsFrom: lookupClass]) 2418 ifFalse: [^ self error: 'lookupClass is not in my inheritance chain']. 2419 self primitiveFailed! ! 2420 2421!Object methodsFor: 'message handling' stamp: 'nk 4/11/2002 14:13'! 2422perform: selector withEnoughArguments: anArray 2423 "Send the selector, aSymbol, to the receiver with arguments in argArray. 2424 Only use enough arguments for the arity of the selector; supply nils for missing ones." 2425 | numArgs args | 2426 numArgs _ selector numArgs. 2427 anArray size == numArgs 2428 ifTrue: [ ^self perform: selector withArguments: anArray asArray ]. 2429 2430 args _ Array new: numArgs. 2431 args replaceFrom: 1 2432 to: (anArray size min: args size) 2433 with: anArray 2434 startingAt: 1. 2435 2436 ^ self perform: selector withArguments: args! ! 2437 2438!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:52'! 2439perform: aSymbol with: anObject 2440 "Send the selector, aSymbol, to the receiver with anObject as its argument. 2441 Fail if the number of arguments expected by the selector is not one. 2442 Primitive. Optional. See Object documentation whatIsAPrimitive." 2443 2444 <primitive: 83> 2445 ^ self perform: aSymbol withArguments: (Array with: anObject)! ! 2446 2447!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:52'! 2448perform: aSymbol with: firstObject with: secondObject 2449 "Send the selector, aSymbol, to the receiver with the given arguments. 2450 Fail if the number of arguments expected by the selector is not two. 2451 Primitive. Optional. See Object documentation whatIsAPrimitive." 2452 2453 <primitive: 83> 2454 ^ self perform: aSymbol withArguments: (Array with: firstObject with: secondObject)! ! 2455 2456!Object methodsFor: 'message handling' stamp: 'di 3/26/1999 07:51'! 2457perform: aSymbol with: firstObject with: secondObject with: thirdObject 2458 "Send the selector, aSymbol, to the receiver with the given arguments. 2459 Fail if the number of arguments expected by the selector is not three. 2460 Primitive. Optional. See Object documentation whatIsAPrimitive." 2461 2462 <primitive: 83> 2463 ^ self perform: aSymbol 2464 withArguments: (Array with: firstObject with: secondObject with: thirdObject)! ! 2465 2466!Object methodsFor: 'message handling' stamp: 'NS 1/28/2004 11:19'! 2467withArgs: argArray executeMethod: compiledMethod 2468 "Execute compiledMethod against the receiver and args in argArray" 2469 2470 | selector | 2471 <primitive: 188> 2472 selector _ Symbol new. 2473 self class addSelectorSilently: selector withMethod: compiledMethod. 2474 ^ [self perform: selector withArguments: argArray] 2475 ensure: [self class basicRemoveSelector: selector]! ! 2476 2477!Object methodsFor: 'message handling' stamp: 'md 1/20/2006 16:28'! 2478with: arg1 executeMethod: compiledMethod 2479 "Execute compiledMethod against the receiver and arg1" 2480 2481 "<primitive: 189>" "uncomment once prim 189 is in VM" 2482 ^ self withArgs: {arg1} executeMethod: compiledMethod! ! 2483 2484!Object methodsFor: 'message handling' stamp: 'md 1/20/2006 16:28'! 2485with: arg1 with: arg2 executeMethod: compiledMethod 2486 "Execute compiledMethod against the receiver and arg1 & arg2" 2487 2488 "<primitive: 189>" "uncomment once prim 189 is in VM" 2489 ^ self withArgs: {arg1. arg2} executeMethod: compiledMethod! ! 2490 2491!Object methodsFor: 'message handling' stamp: 'md 1/20/2006 16:28'! 2492with: arg1 with: arg2 with: arg3 executeMethod: compiledMethod 2493 "Execute compiledMethod against the receiver and arg1, arg2, & arg3" 2494 2495 "<primitive: 189>" "uncomment once prim 189 is in VM" 2496 ^ self withArgs: {arg1. arg2. arg3} executeMethod: compiledMethod! ! 2497 2498!Object methodsFor: 'message handling' stamp: 'md 1/20/2006 16:28'! 2499with: arg1 with: arg2 with: arg3 with: arg4 executeMethod: compiledMethod 2500 "Execute compiledMethod against the receiver and arg1, arg2, arg3, & arg4" 2501 2502 "<primitive: 189>" "uncomment once prim 189 is in VM" 2503 ^ self withArgs: {arg1. arg2. arg3. arg4} executeMethod: compiledMethod! ! 2504 2505 2506!Object methodsFor: 'objects from disk' stamp: 'tk 4/8/1999 12:46'! 2507comeFullyUpOnReload: smartRefStream 2508 "Normally this read-in object is exactly what we want to store. 7/26/96 tk" 2509 2510 ^ self! ! 2511 2512!Object methodsFor: 'objects from disk' stamp: 'RAA 12/20/2000 16:51'! 2513convertToCurrentVersion: varDict refStream: smartRefStrm 2514 2515 "subclasses should implement if they wish to convert old instances to modern ones"! ! 2516 2517!Object methodsFor: 'objects from disk' stamp: 'tk 11/29/2004 15:04'! 2518fixUponLoad: aProject seg: anImageSegment 2519 "change the object due to conventions that have changed on 2520the project level. (sent to all objects in the incoming project). 2521Specific classes should reimplement this."! ! 2522 2523!Object methodsFor: 'objects from disk' stamp: 'RAA 1/10/2001 14:02'! 2524indexIfCompact 2525 2526 ^0 "helps avoid a #respondsTo: in publishing"! ! 2527 2528!Object methodsFor: 'objects from disk' stamp: 'tk 2/24/1999 11:08'! 2529objectForDataStream: refStrm 2530 "Return an object to store on an external data stream." 2531 2532 ^ self! ! 2533 2534!Object methodsFor: 'objects from disk' stamp: 'tk 4/8/1999 12:05'! 2535readDataFrom: aDataStream size: varsOnDisk 2536 "Fill in the fields of self based on the contents of aDataStream. Return self. 2537 Read in the instance-variables written by Object>>storeDataOn:. 2538 NOTE: This method must send beginReference: before reading any objects from aDataStream that might reference it. 2539 Allow aDataStream to have fewer inst vars. See SmartRefStream." 2540 | cntInstVars cntIndexedVars | 2541 2542 cntInstVars _ self class instSize. 2543 self class isVariable 2544 ifTrue: [cntIndexedVars _ varsOnDisk - cntInstVars. 2545 cntIndexedVars < 0 ifTrue: [ 2546 self error: 'Class has changed too much. Define a convertxxx method']] 2547 ifFalse: [cntIndexedVars _ 0. 2548 cntInstVars _ varsOnDisk]. "OK if fewer than now" 2549 2550 aDataStream beginReference: self. 2551 1 to: cntInstVars do: 2552 [:i | self instVarAt: i put: aDataStream next]. 2553 1 to: cntIndexedVars do: 2554 [:i | self basicAt: i put: aDataStream next]. 2555 "Total number read MUST be equal to varsOnDisk!!" 2556 ^ self "If we ever return something other than self, fix calls 2557 on (super readDataFrom: aDataStream size: anInteger)"! ! 2558 2559!Object methodsFor: 'objects from disk' stamp: 'CdG 10/17/2005 20:32'! 2560saveOnFile 2561 "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. Does not file out the class of the object. tk 6/26/97 13:48" 2562 2563 | aFileName fileStream | 2564 aFileName := self class name asFileName. "do better?" 2565 aFileName := UIManager default 2566 request: 'File name?' translated initialAnswer: aFileName. 2567 aFileName size == 0 ifTrue: [^ Beeper beep]. 2568 2569 fileStream := FileStream newFileNamed: aFileName asFileName. 2570 fileStream fileOutClass: nil andObject: self.! ! 2571 2572!Object methodsFor: 'objects from disk' stamp: 'tk 8/9/2001 15:40'! 2573storeDataOn: aDataStream 2574 "Store myself on a DataStream. Answer self. This is a low-level DataStream/ReferenceStream method. See also objectToStoreOnDataStream. NOTE: This method must send 'aDataStream beginInstance:size:' and then (nextPut:/nextPutWeak:) its subobjects. readDataFrom:size: reads back what we write here." 2575 | cntInstVars cntIndexedVars | 2576 2577 cntInstVars _ self class instSize. 2578 cntIndexedVars _ self basicSize. 2579 aDataStream 2580 beginInstance: self class 2581 size: cntInstVars + cntIndexedVars. 2582 1 to: cntInstVars do: 2583 [:i | aDataStream nextPut: (self instVarAt: i)]. 2584 2585 "Write fields of a variable length object. When writing to a dummy 2586 stream, don't bother to write the bytes" 2587 ((aDataStream byteStream class == DummyStream) and: [self class isBits]) ifFalse: [ 2588 1 to: cntIndexedVars do: 2589 [:i | aDataStream nextPut: (self basicAt: i)]]. 2590! ! 2591 2592 2593!Object methodsFor: 'parts bin' stamp: 'sw 10/24/2001 16:34'! 2594descriptionForPartsBin 2595 "If the receiver is a member of a class that would like to be represented in a parts bin, answer the name by which it should be known, and a documentation string to be provided, for example, as balloon help. When the 'nativitySelector' is sent to the 'globalReceiver', it is expected that some kind of Morph will result. The parameters used in the implementation below are for documentation purposes only!!" 2596 2597 ^ DescriptionForPartsBin 2598 formalName: 'PutFormalNameHere' 2599 categoryList: #(PutACategoryHere MaybePutAnotherCategoryHere) 2600 documentation: 'Put the balloon help here' 2601 globalReceiverSymbol: #PutAGlobalHere 2602 nativitySelector: #PutASelectorHere! ! 2603 2604 2605!Object methodsFor: 'printing' stamp: 'di 6/20/97 08:57'! 2606fullPrintString 2607 "Answer a String whose characters are a description of the receiver." 2608 2609 ^ String streamContents: [:s | self printOn: s]! ! 2610 2611!Object methodsFor: 'printing'! 2612isLiteral 2613 "Answer whether the receiver has a literal text form recognized by the 2614 compiler." 2615 2616 ^false! ! 2617 2618!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:28'! 2619longPrintOn: aStream 2620 "Append to the argument, aStream, the names and values of all 2621 of the receiver's instance variables." 2622 2623 self class allInstVarNames doWithIndex: 2624 [:title :index | 2625 aStream nextPutAll: title; 2626 nextPut: $:; 2627 space; 2628 tab; 2629 print: (self instVarAt: index); 2630 cr]! ! 2631 2632!Object methodsFor: 'printing' stamp: 'tk 10/19/2001 11:18'! 2633longPrintOn: aStream limitedTo: sizeLimit indent: indent 2634 "Append to the argument, aStream, the names and values of all of the receiver's instance variables. Limit is the length limit for each inst var." 2635 2636 self class allInstVarNames doWithIndex: 2637 [:title :index | 2638 indent timesRepeat: [aStream tab]. 2639 aStream nextPutAll: title; 2640 nextPut: $:; 2641 space; 2642 tab; 2643 nextPutAll: 2644 ((self instVarAt: index) printStringLimitedTo: (sizeLimit -3 -title size max: 1)); 2645 cr]! ! 2646 2647!Object methodsFor: 'printing' stamp: 'tk 10/16/2001 19:41'! 2648longPrintString 2649 "Answer a String whose characters are a description of the receiver." 2650 2651 | str | 2652 str _ String streamContents: [:aStream | self longPrintOn: aStream]. 2653 "Objects without inst vars should return something" 2654 ^ str isEmpty ifTrue: [self printString, String cr] ifFalse: [str]! ! 2655 2656!Object methodsFor: 'printing' stamp: 'BG 11/7/2004 13:39'! 2657longPrintStringLimitedTo: aLimitValue 2658 "Answer a String whose characters are a description of the receiver." 2659 2660 | str | 2661 str _ String streamContents: [:aStream | self longPrintOn: aStream limitedTo: aLimitValue indent: 0]. 2662 "Objects without inst vars should return something" 2663 ^ str isEmpty ifTrue: [self printString, String cr] ifFalse: [str]! ! 2664 2665!Object methodsFor: 'printing' stamp: 'sw 3/7/2001 13:14'! 2666nominallyUnsent: aSelectorSymbol 2667 "From within the body of a method which is not formally sent within the system, but which you intend to have remain in the system (for potential manual invocation, or for documentation, or perhaps because it's sent by commented-out-code that you anticipate uncommenting out someday, send this message, with the selector itself as the argument. 2668 2669This will serve two purposes: 2670 2671 (1) The method will not be returned by searches for unsent selectors (because it, in a manner of speaking, sends itself). 2672 (2) You can locate all such methods by browsing senders of #nominallyUnsent:" 2673 2674 false ifTrue: [self flag: #nominallyUnsent:] "So that this method itself will appear to be sent" 2675! ! 2676 2677!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:31'! 2678printOn: aStream 2679 "Append to the argument, aStream, a sequence of characters that 2680 identifies the receiver." 2681 2682 | title | 2683 title _ self class name. 2684 aStream 2685 nextPutAll: (title first isVowel ifTrue: ['an '] ifFalse: ['a ']); 2686 nextPutAll: title! ! 2687 2688!Object methodsFor: 'printing' stamp: 'sma 6/1/2000 09:22'! 2689printString 2690 "Answer a String whose characters are a description of the receiver. 2691 If you want to print without a character limit, use fullPrintString." 2692 2693 ^ self printStringLimitedTo: 50000! ! 2694 2695!Object methodsFor: 'printing' stamp: 'tk 5/7/1999 16:20'! 2696printStringLimitedTo: limit 2697 "Answer a String whose characters are a description of the receiver. 2698 If you want to print without a character limit, use fullPrintString." 2699 | limitedString | 2700 limitedString _ String streamContents: [:s | self printOn: s] limitedTo: limit. 2701 limitedString size < limit ifTrue: [^ limitedString]. 2702 ^ limitedString , '...etc...'! ! 2703 2704!Object methodsFor: 'printing' stamp: 'MPW 1/1/1901 00:30'! 2705propertyList 2706 "Answer a String whose characters are a property-list description of the receiver." 2707 2708 ^ PropertyListEncoder process:self. 2709! ! 2710 2711!Object methodsFor: 'printing' stamp: 'sw 10/17/2000 11:16'! 2712reportableSize 2713 "Answer a string that reports the size of the receiver -- useful for showing in a list view, for example" 2714 2715 ^ (self basicSize + self class instSize) printString! ! 2716 2717!Object methodsFor: 'printing'! 2718storeOn: aStream 2719 "Append to the argument aStream a sequence of characters that is an 2720 expression whose evaluation creates an object similar to the receiver." 2721 2722 aStream nextPut: $(. 2723 self class isVariable 2724 ifTrue: [aStream nextPutAll: '(', self class name, ' basicNew: '; 2725 store: self basicSize; 2726 nextPutAll: ') '] 2727 ifFalse: [aStream nextPutAll: self class name, ' basicNew']. 2728 1 to: self class instSize do: 2729 [:i | 2730 aStream nextPutAll: ' instVarAt: '; 2731 store: i; 2732 nextPutAll: ' put: '; 2733 store: (self instVarAt: i); 2734 nextPut: $;]. 2735 1 to: self basicSize do: 2736 [:i | 2737 aStream nextPutAll: ' basicAt: '; 2738 store: i; 2739 nextPutAll: ' put: '; 2740 store: (self basicAt: i); 2741 nextPut: $;]. 2742 aStream nextPutAll: ' yourself)' 2743! ! 2744 2745!Object methodsFor: 'printing' stamp: 'di 6/20/97 09:12'! 2746storeString 2747 "Answer a String representation of the receiver from which the receiver 2748 can be reconstructed." 2749 2750 ^ String streamContents: [:s | self storeOn: s]! ! 2751 2752!Object methodsFor: 'printing' stamp: 'sw 5/2/1998 13:55'! 2753stringForReadout 2754 ^ self stringRepresentation! ! 2755 2756!Object methodsFor: 'printing'! 2757stringRepresentation 2758 "Answer a string that represents the receiver. For most objects this is simply its printString, but for strings themselves, it's themselves. 6/12/96 sw" 2759 2760 ^ self printString ! ! 2761 2762 2763!Object methodsFor: 'scripting' stamp: 'ar 3/17/2001 20:11'! 2764adaptedToWorld: aWorld 2765 "If I refer to a world or a hand, return the corresponding items in the new world." 2766 ^self! ! 2767 2768!Object methodsFor: 'scripting' stamp: 'sw 3/10/2000 13:57'! 2769defaultFloatPrecisionFor: aGetSelector 2770 "Answer a number indicating the default float precision to be used in a numeric readout for which the receiver is the model." 2771 2772 ^ 1! ! 2773 2774!Object methodsFor: 'scripting' stamp: 'RAA 3/9/2001 17:08'! 2775evaluateUnloggedForSelf: aCodeString 2776 2777 ^Compiler evaluate: 2778 aCodeString 2779 for: self 2780 logged: false! ! 2781 2782!Object methodsFor: 'scripting' stamp: 'yo 12/25/2003 16:43'! 2783methodInterfacesForCategory: aCategorySymbol inVocabulary: aVocabulary limitClass: aLimitClass 2784 "Return a list of methodInterfaces for the receiver in the given category, given a vocabulary. aCategorySymbol is the inherent category symbol, not necessarily the wording as expressed in the vocabulary." 2785 2786 | categorySymbol | 2787 categorySymbol _ aCategorySymbol asSymbol. 2788 2789 (categorySymbol == ScriptingSystem nameForInstanceVariablesCategory) ifTrue: [ 2790 "user-defined instance variables" 2791 ^ self methodInterfacesForInstanceVariablesCategoryIn: aVocabulary]. 2792 (categorySymbol == ScriptingSystem nameForScriptsCategory) ifTrue: [ 2793 "user-defined scripts" 2794 ^ self methodInterfacesForScriptsCategoryIn: aVocabulary]. 2795 "all others" 2796 ^ self usableMethodInterfacesIn: (aVocabulary methodInterfacesInCategory: categorySymbol 2797 forInstance: self 2798 ofClass: self class 2799 limitClass: aLimitClass) 2800! ! 2801 2802!Object methodsFor: 'scripting' stamp: 'sw 8/3/2001 13:54'! 2803methodInterfacesForInstanceVariablesCategoryIn: aVocabulary 2804 "Return a collection of methodInterfaces for the instance-variables category. The vocabulary parameter, at present anyway, is not used. And for non-players, the method is at present vacuous in any case" 2805 2806 ^ OrderedCollection new! ! 2807 2808!Object methodsFor: 'scripting' stamp: 'sw 8/3/2001 13:53'! 2809methodInterfacesForScriptsCategoryIn: aVocabulary 2810 "Answer a list of method interfaces for the category #scripts, as seen in a viewer or other tool. The vocabulary argument is not presently used. Also, at present, only Players really do anyting interesting here." 2811 2812 ^ OrderedCollection new! ! 2813 2814!Object methodsFor: 'scripting' stamp: 'RAA 2/16/2001 19:37'! 2815selfWrittenAsIll 2816 2817 ^self! ! 2818 2819!Object methodsFor: 'scripting' stamp: 'RAA 2/16/2001 19:38'! 2820selfWrittenAsIm 2821 2822 ^self! ! 2823 2824!Object methodsFor: 'scripting' stamp: 'RAA 2/16/2001 19:37'! 2825selfWrittenAsMe 2826 2827 ^self! ! 2828 2829!Object methodsFor: 'scripting' stamp: 'RAA 2/16/2001 19:37'! 2830selfWrittenAsMy 2831 2832 ^self! ! 2833 2834!Object methodsFor: 'scripting' stamp: 'RAA 2/16/2001 19:38'! 2835selfWrittenAsThis 2836 2837 ^self! ! 2838 2839 2840!Object methodsFor: 'scripts-kernel' stamp: 'nk 10/14/2004 10:55'! 2841universalTilesForGetterOf: aMethodInterface 2842 "Return universal tiles for a getter on the given method interface." 2843 2844 | ms argTile argArray itsSelector | 2845 itsSelector _ aMethodInterface selector. 2846 argArray _ #(). 2847 2848 "Four gratuituous special cases..." 2849 2850 (itsSelector == #color:sees:) ifTrue: 2851 [argTile _ ScriptingSystem tileForArgType: #Color. 2852 argArray _ Array with: argTile colorSwatch color with: argTile colorSwatch color copy]. 2853 2854 itsSelector == #seesColor: ifTrue: 2855 [argTile _ ScriptingSystem tileForArgType: #Color. 2856 argArray _ Array with: argTile colorSwatch color]. 2857 2858 (#(touchesA: overlaps: overlapsAny:) includes: itsSelector) ifTrue: 2859 [argTile _ ScriptingSystem tileForArgType: #Player. 2860 argArray _ Array with: argTile actualObject]. 2861 2862 ms _ MessageSend receiver: self selector: itsSelector arguments: argArray. 2863 ^ ms asTilesIn: self class globalNames: (self class officialClass ~~ CardPlayer) 2864 "For CardPlayers, use 'self'. For others, name it, and use its name."! ! 2865 2866!Object methodsFor: 'scripts-kernel' stamp: 'tk 9/28/2001 13:30'! 2867universalTilesForInterface: aMethodInterface 2868 "Return universal tiles for the given method interface. Record who self is." 2869 2870 | ms argTile itsSelector aType argList | 2871 itsSelector _ aMethodInterface selector. 2872 argList _ OrderedCollection new. 2873 aMethodInterface argumentVariables doWithIndex: 2874 [:anArgumentVariable :anIndex | 2875 argTile _ ScriptingSystem tileForArgType: (aType _ aMethodInterface typeForArgumentNumber: anIndex). 2876 argList add: (aType == #Player 2877 ifTrue: [argTile actualObject] 2878 ifFalse: [argTile literal]). "default value for each type"]. 2879 2880 ms _ MessageSend receiver: self selector: itsSelector arguments: argList asArray. 2881 ^ ms asTilesIn: self class globalNames: (self class officialClass ~~ CardPlayer) 2882 "For CardPlayers, use 'self'. For others, name it, and use its name."! ! 2883 2884 2885!Object methodsFor: 'self evaluating' stamp: 'sd 7/31/2005 21:47'! 2886isSelfEvaluating 2887 ^ self isLiteral! ! 2888 2889 2890!Object methodsFor: 'system primitives'! 2891asOop 2892 "Primitive. Answer a SmallInteger whose value is half of the receiver's 2893 object pointer (interpreting object pointers as 16-bit signed quantities). 2894 Fail if the receiver is a SmallInteger. Essential. See Object documentation 2895 whatIsAPrimitive." 2896 2897 <primitive: 75> 2898 self primitiveFailed! ! 2899 2900!Object methodsFor: 'system primitives' stamp: 'di 1/9/1999 15:19'! 2901becomeForward: otherObject 2902 "Primitive. All variables in the entire system that used to point 2903 to the receiver now point to the argument. 2904 Fails if either argument is a SmallInteger." 2905 2906 (Array with: self) 2907 elementsForwardIdentityTo: 2908 (Array with: otherObject)! ! 2909 2910!Object methodsFor: 'system primitives' stamp: 'zz 3/3/2004 23:53'! 2911becomeForward: otherObject copyHash: copyHash 2912 "Primitive. All variables in the entire system that used to point to the receiver now point to the argument. 2913 If copyHash is true, the argument's identity hash bits will be set to those of the receiver. 2914 Fails if either argument is a SmallInteger." 2915 2916 (Array with: self) 2917 elementsForwardIdentityTo: 2918 (Array with: otherObject) 2919 copyHash: copyHash! ! 2920 2921!Object methodsFor: 'system primitives' stamp: 'sw 10/16/2000 10:59'! 2922className 2923 "Answer a string characterizing the receiver's class, for use in list views for example" 2924 2925 ^ self class name asString! ! 2926 2927!Object methodsFor: 'system primitives' stamp: 'sw 10/16/2000 11:04'! 2928creationStamp 2929 "Answer a string which reports the creation particulars of the receiver. Intended perhaps for list views, but this is presently a feature not easily accessible" 2930 2931 ^ '<no creation stamp>'! ! 2932 2933!Object methodsFor: 'system primitives'! 2934instVarAt: index 2935 "Primitive. Answer a fixed variable in an object. The numbering of the 2936 variables corresponds to the named instance variables. Fail if the index 2937 is not an Integer or is not the index of a fixed variable. Essential. See 2938 Object documentation whatIsAPrimitive." 2939 2940 <primitive: 73> 2941 "Access beyond fixed variables." 2942 ^self basicAt: index - self class instSize ! ! 2943 2944!Object methodsFor: 'system primitives'! 2945instVarAt: anInteger put: anObject 2946 "Primitive. Store a value into a fixed variable in the receiver. The 2947 numbering of the variables corresponds to the named instance variables. 2948 Fail if the index is not an Integer or is not the index of a fixed variable. 2949 Answer the value stored as the result. Using this message violates the 2950 principle that each object has sovereign control over the storing of 2951 values into its instance variables. Essential. See Object documentation 2952 whatIsAPrimitive." 2953 2954 <primitive: 74> 2955 "Access beyond fixed fields" 2956 ^self basicAt: anInteger - self class instSize put: anObject! ! 2957 2958!Object methodsFor: 'system primitives' stamp: 'sw 10/16/2000 11:09'! 2959instVarNamed: aString 2960 "Return the value of the instance variable in me with that name. Slow and unclean, but very useful. " 2961 2962 ^ self instVarAt: (self class allInstVarNames indexOf: aString asString) 2963 2964 2965! ! 2966 2967!Object methodsFor: 'system primitives' stamp: 'sw 10/16/2000 11:10'! 2968instVarNamed: aString put: aValue 2969 "Store into the value of the instance variable in me of that name. Slow and unclean, but very useful. " 2970 2971 ^ self instVarAt: (self class allInstVarNames indexOf: aString asString) put: aValue 2972! ! 2973 2974!Object methodsFor: 'system primitives' stamp: 'sw 10/17/2000 11:12'! 2975oopString 2976 "Answer a string that represents the oop of the receiver" 2977 2978 ^ self asOop printString! ! 2979 2980!Object methodsFor: 'system primitives' stamp: 'ar 3/2/2001 01:34'! 2981primitiveChangeClassTo: anObject 2982 "Primitive. Change the class of the receiver into the class of the argument given that the format of the receiver matches the format of the argument's class. Fail if receiver or argument are SmallIntegers, or the receiver is an instance of a compact class and the argument isn't, or when the argument's class is compact and the receiver isn't, or when the format of the receiver is different from the format of the argument's class, or when the arguments class is fixed and the receiver's size differs from the size that an instance of the argument's class should have. 2983 Note: The primitive will fail in most cases that you think might work. This is mostly because of a) the difference between compact and non-compact classes, and b) because of differences in the format. As an example, '(Array new: 3) primitiveChangeClassTo: Morph basicNew' would fail for three of the reasons mentioned above. Array is compact, Morph is not (failure #1). Array is variable and Morph is fixed (different format - failure #2). Morph is a fixed-field-only object and the array is too short (failure #3). 2984 The facility is really provided for certain, very specific applications (mostly related to classes changing shape) and not for casual use." 2985 2986 <primitive: 115> 2987 self primitiveFailed! ! 2988 2989!Object methodsFor: 'system primitives' stamp: 'di 3/27/1999 12:21'! 2990rootStubInImageSegment: imageSegment 2991 2992 ^ ImageSegmentRootStub new 2993 xxSuperclass: nil 2994 format: nil 2995 segment: imageSegment! ! 2996 2997!Object methodsFor: 'system primitives'! 2998someObject 2999 "Primitive. Answer the first object in the enumeration of all 3000 objects." 3001 3002 <primitive: 138> 3003 self primitiveFailed.! ! 3004 3005 3006!Object methodsFor: 'testing' stamp: 'sw 9/26/2001 11:58'! 3007basicType 3008 "Answer a symbol representing the inherent type of the receiver" 3009 3010 ^ #Object! ! 3011 3012!Object methodsFor: 'testing' stamp: 'sw 5/3/2001 16:19'! 3013beViewed 3014 "Open up a viewer on the receiver. The Presenter is invited to decide just how to present this viewer" 3015 3016 self uniqueNameForReference. "So the viewer will have something nice to refer to" 3017 self presenter viewObject: self! ! 3018 3019!Object methodsFor: 'testing' stamp: 'sw 10/16/2000 11:01'! 3020costumes 3021 "Answer a list of costumes associated with the receiver. The appearance of this method in class Object serves only as a backstop, probably only transitionally" 3022 3023 ^ nil! ! 3024 3025!Object methodsFor: 'testing' stamp: 'sw 1/12/98 18:09'! 3026haltIfNil! ! 3027 3028!Object methodsFor: 'testing' stamp: 'md 1/20/2006 17:09'! 3029hasLiteralSuchThat: testBlock 3030 "This is the end of the imbedded structure path so return false." 3031 3032 ^ false! ! 3033 3034!Object methodsFor: 'testing' stamp: 'md 1/20/2006 17:10'! 3035hasLiteralThorough: literal 3036 "Answer true if literal is identical to any literal in this array, even if imbedded in further structures. This is the end of the imbedded structure path so return false." 3037 3038 ^ false! ! 3039 3040!Object methodsFor: 'testing' stamp: 'sw 1/30/2001 22:24'! 3041haveFullProtocolBrowsed 3042 "Open up a Lexicon on the receiver" 3043 3044 ^ self haveFullProtocolBrowsedShowingSelector: nil 3045 3046 "(2@3) haveFullProtocolBrowsed" 3047! ! 3048 3049!Object methodsFor: 'testing' stamp: 'ar 9/27/2005 21:04'! 3050haveFullProtocolBrowsedShowingSelector: aSelector 3051 "Open up a Lexicon on the receiver, having it open up showing aSelector, which may be nil" 3052 3053 | aBrowser | 3054 aBrowser := (Smalltalk at: #InstanceBrowser ifAbsent:[^nil]) new useVocabulary: Vocabulary fullVocabulary. 3055 aBrowser openOnObject: self inWorld: ActiveWorld showingSelector: aSelector 3056 3057 "(2@3) haveFullProtocolBrowsed"! ! 3058 3059!Object methodsFor: 'testing' stamp: 'md 7/30/2005 21:21'! 3060isArray 3061 ^false! ! 3062 3063!Object methodsFor: 'testing' stamp: 'ar 7/9/1999 18:18'! 3064isBehavior 3065 "Return true if the receiver is a behavior. 3066 Note: Do not override in any class except behavior." 3067 ^false! ! 3068 3069!Object methodsFor: 'testing' stamp: 'ajh 1/21/2003 13:15'! 3070isBlock 3071 3072 ^ false! ! 3073 3074!Object methodsFor: 'testing' stamp: 'md 11/21/2003 12:14'! 3075isBlockClosure 3076 3077 ^ false! ! 3078 3079!Object methodsFor: 'testing' stamp: 'yo 8/28/2002 13:41'! 3080isCharacter 3081 3082 ^ false. 3083! ! 3084 3085!Object methodsFor: 'testing' stamp: 'ar 8/17/1999 19:43'! 3086isCollection 3087 "Return true if the receiver is some sort of Collection and responds to basic collection messages such as #size and #do:" 3088 ^false! ! 3089 3090!Object methodsFor: 'testing'! 3091isColor 3092 "Answer true if receiver is a Color. False by default." 3093 3094 ^ false 3095! ! 3096 3097!Object methodsFor: 'testing' stamp: 'nk 4/17/2004 19:43'! 3098isColorForm 3099 ^false! ! 3100 3101!Object methodsFor: 'testing' stamp: 'md 11/21/2003 12:14'! 3102isCompiledMethod 3103 3104 ^ false! ! 3105 3106!Object methodsFor: 'testing' stamp: 'mk 10/27/2003 17:33'! 3107isComplex 3108 "Answer true if receiver is a Complex number. False by default." 3109 3110 ^ false 3111! ! 3112 3113!Object methodsFor: 'testing' stamp: 'md 8/11/2005 16:45'! 3114isDictionary 3115 ^false! ! 3116 3117!Object methodsFor: 'testing' stamp: 'di 11/9/1998 09:38'! 3118isFloat 3119 "Overridden to return true in Float, natch" 3120 ^ false! ! 3121 3122!Object methodsFor: 'testing' stamp: 'ar 10/30/2000 23:22'! 3123isForm 3124 ^false! ! 3125 3126!Object methodsFor: 'testing' stamp: 'len 1/13/98 21:18'! 3127isFraction 3128 "Answer true if the receiver is a Fraction." 3129 3130 ^ false! ! 3131 3132!Object methodsFor: 'testing' stamp: 'rhi 8/14/2003 08:51'! 3133isHeap 3134 3135 ^ false! ! 3136 3137!Object methodsFor: 'testing'! 3138isInteger 3139 "Overridden to return true in Integer." 3140 3141 ^ false! ! 3142 3143!Object methodsFor: 'testing' stamp: 'rhi 8/12/2003 09:52'! 3144isInterval 3145 3146 ^ false! ! 3147 3148!Object methodsFor: 'testing' stamp: 'nk 4/25/2002 08:04'! 3149isMessageSend 3150 ^false 3151! ! 3152 3153!Object methodsFor: 'testing' stamp: 'md 2/19/2006 11:24'! 3154isMethodProperties 3155 ^false! ! 3156 3157!Object methodsFor: 'testing'! 3158isMorph 3159 3160 ^ false! ! 3161 3162!Object methodsFor: 'testing' stamp: 'ar 9/13/2000 15:37'! 3163isMorphicEvent 3164 ^false! ! 3165 3166!Object methodsFor: 'testing' stamp: 'gm 2/22/2003 12:56'! 3167isMorphicModel 3168 "Return true if the receiver is a morphic model" 3169 ^false 3170! ! 3171 3172!Object methodsFor: 'testing'! 3173isNumber 3174 "Overridden to return true in Number, natch" 3175 ^ false! ! 3176 3177!Object methodsFor: 'testing' stamp: 'di 11/6/1998 08:04'! 3178isPoint 3179 "Overridden to return true in Point." 3180 3181 ^ false! ! 3182 3183!Object methodsFor: 'testing' stamp: 'ikp 9/26/97 14:45'! 3184isPseudoContext 3185 ^false! ! 3186 3187!Object methodsFor: 'testing' stamp: 'md 10/2/2005 21:52'! 3188isRectangle 3189 ^false! ! 3190 3191!Object methodsFor: 'testing' stamp: 'nk 6/14/2004 16:49'! 3192isSketchMorph 3193 ^false! ! 3194 3195!Object methodsFor: 'testing' stamp: 'ar 12/23/1999 15:43'! 3196isStream 3197 "Return true if the receiver responds to the stream protocol" 3198 ^false 3199! ! 3200 3201!Object methodsFor: 'testing' stamp: 'sma 6/15/2000 15:48'! 3202isString 3203 "Overridden to return true in String, natch" 3204 ^ false! ! 3205 3206!Object methodsFor: 'testing' stamp: 'md 4/30/2003 15:30'! 3207isSymbol 3208 ^ false ! ! 3209 3210!Object methodsFor: 'testing' stamp: 'jam 3/9/2003 15:10'! 3211isSystemWindow 3212"answer whatever the receiver is a SystemWindow" 3213 ^ false! ! 3214 3215!Object methodsFor: 'testing'! 3216isText 3217 ^ false! ! 3218 3219!Object methodsFor: 'testing' stamp: 'pmm 7/6/2006 20:46'! 3220isTrait 3221 "Return true if the receiver is a trait. 3222 Note: Do not override in any class except TraitBehavior." 3223 ^false! ! 3224 3225!Object methodsFor: 'testing' stamp: 'tk 10/21/97 12:45'! 3226isTransparent 3227 ^ false! ! 3228 3229!Object methodsFor: 'testing' stamp: 'ar 8/14/2001 23:19'! 3230isVariableBinding 3231 "Return true if I represent a literal variable binding" 3232 ^false 3233 ! ! 3234 3235!Object methodsFor: 'testing' stamp: 'ls 7/14/1998 21:45'! 3236isWebBrowser 3237 "whether this object is a web browser. See class: Scamper" 3238 ^false! ! 3239 3240!Object methodsFor: 'testing' stamp: 'sw 10/27/2000 06:58'! 3241knownName 3242 "If a formal name has been handed out for this object, answer it, else nil" 3243 3244 ^ Preferences capitalizedReferences 3245 ifTrue: 3246 [References keyAtValue: self ifAbsent: [nil]] 3247 ifFalse: 3248 [nil]! ! 3249 3250!Object methodsFor: 'testing' stamp: 'sw 9/27/96'! 3251name 3252 "Answer a name for the receiver. This is used generically in the title of certain inspectors, such as the referred-to inspector, and specificially by various subsystems. By default, we let the object just print itself out.. " 3253 3254 ^ self printString! ! 3255 3256!Object methodsFor: 'testing' stamp: 'sw 11/19/2001 13:28'! 3257nameForViewer 3258 "Answer a name to be shown in a Viewer that is viewing the receiver" 3259 3260 | aName | 3261 (aName _ self uniqueNameForReferenceOrNil) ifNotNil: [^ aName]. 3262 (aName _ self knownName) ifNotNil: [^ aName]. 3263 3264 ^ [(self asString copyWithout: Character cr) truncateTo: 27] ifError: 3265 [:msg :rcvr | ^ self class name printString]! ! 3266 3267!Object methodsFor: 'testing'! 3268notNil 3269 "Coerces nil to false and everything else to true." 3270 3271 ^true! ! 3272 3273!Object methodsFor: 'testing' stamp: 'tk 9/6/2001 19:15'! 3274openInstanceBrowserWithTiles 3275 "Open up an instance browser on me with tiles as the code type, and with the search level as desired." 3276 3277 | aBrowser | 3278 aBrowser _ InstanceBrowser new. 3279 aBrowser useVocabulary: Vocabulary fullVocabulary. 3280 aBrowser limitClass: self class. 3281 aBrowser contentsSymbol: #tiles. "preset it to make extra buttons (tile menus)" 3282 aBrowser openOnObject: self inWorld: ActiveWorld showingSelector: nil. 3283 aBrowser contentsSymbol: #source. 3284 aBrowser toggleShowingTiles. 3285 3286 " 3287(2@3) openInstanceBrowserWithTiles. 3288WatchMorph new openInstanceBrowserWithTiles 3289"! ! 3290 3291!Object methodsFor: 'testing' stamp: 'tk 7/28/2005 04:50'! 3292renameInternal: newName 3293 "Change the internal name (because of a conflict) but leave the external name unchanged. Change Player class name, but do not change the names that appear in tiles. Any object that might be pointed to in the References dictionary might get this message sent to it upon reload" 3294 3295 ^ nil "caller will renameTo:. new name may be different"! ! 3296 3297!Object methodsFor: 'testing' stamp: 'sw 2/27/2002 14:55'! 3298renameTo: newName 3299 "If the receiver has an inherent idea about its own name, it should take action here. Any object that might be pointed to in the References dictionary might get this message sent to it upon reload"! ! 3300 3301!Object methodsFor: 'testing' stamp: 'sw 1/18/2001 13:43'! 3302showDiffs 3303 "Answer whether the receiver, serving as the model of a text-bearing entity, is 'showing differences' -- if it is, the editor may wish to show special feedback" 3304 3305 ^ false! ! 3306 3307!Object methodsFor: 'testing' stamp: 'sw 10/20/1999 14:52'! 3308stepAt: millisecondClockValue in: aWindow 3309 3310 ^ self stepIn: aWindow! ! 3311 3312!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:16'! 3313stepIn: aWindow 3314 3315 ^ self step! ! 3316 3317!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:21'! 3318stepTime 3319 3320 ^ 1000 "milliseconds -- default backstop for objects serving as models of system windows"! ! 3321 3322!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:22'! 3323stepTimeIn: aSystemWindow 3324 3325 ^ 1000 "milliseconds -- default backstop for objects serving as models of system windows"! ! 3326 3327!Object methodsFor: 'testing' stamp: 'sw 5/3/2001 18:22'! 3328vocabularyDemanded 3329 "Answer a vocabulary that the receiver insists be used when it is looked at in a Viewer. This allows specific classes to insist on specific custom vocabularies" 3330 3331 ^ nil! ! 3332 3333!Object methodsFor: 'testing' stamp: 'sw 11/13/2001 07:26'! 3334wantsDiffFeedback 3335 "Answer whether the receiver, serving as the model of a text-bearing entity, would like for 'diffs' green pane-border feedback to be shown" 3336 3337 ^ false! ! 3338 3339!Object methodsFor: 'testing' stamp: 'di 1/8/1999 15:04'! 3340wantsSteps 3341 "Overridden by morphic classes whose instances want to be stepped, 3342 or by model classes who want their morphic views to be stepped." 3343 3344 ^ false! ! 3345 3346!Object methodsFor: 'testing' stamp: 'sw 10/19/1999 08:26'! 3347wantsStepsIn: aSystemWindow 3348 3349 ^ self wantsSteps! ! 3350 3351 3352!Object methodsFor: 'thumbnail' stamp: 'dgd 9/25/2004 23:17'! 3353iconOrThumbnailOfSize: aNumberOrPoint 3354 "Answer an appropiate form to represent the receiver" 3355 ^ nil! ! 3356 3357 3358!Object methodsFor: 'translation support'! 3359inline: inlineFlag 3360 "For translation only; noop when running in Smalltalk."! ! 3361 3362!Object methodsFor: 'translation support'! 3363var: varSymbol declareC: declString 3364 "For translation only; noop when running in Smalltalk."! ! 3365 3366 3367!Object methodsFor: 'undo' stamp: 'di 9/11/2000 20:32'! 3368capturedState 3369 "May be overridden in subclasses." 3370 3371 ^ self shallowCopy 3372! ! 3373 3374!Object methodsFor: 'undo' stamp: 'di 9/11/2000 20:29'! 3375commandHistory 3376 "Return the command history for the receiver" 3377 | w | 3378 (w _ self currentWorld) ifNotNil: [^ w commandHistory]. 3379 ^ CommandHistory new. "won't really record anything but prevent breaking things"! ! 3380 3381!Object methodsFor: 'undo' stamp: 'di 12/12/2000 15:01'! 3382purgeAllCommands 3383 "Purge all commands for this object" 3384 Preferences useUndo ifFalse: [^ self]. "get out quickly" 3385 self commandHistory purgeAllCommandsSuchThat: [:cmd | cmd undoTarget == self]. 3386! ! 3387 3388!Object methodsFor: 'undo' stamp: 'di 9/12/2000 08:15'! 3389redoFromCapturedState: st 3390 "May be overridden in subclasses. See also capturedState" 3391 3392 self undoFromCapturedState: st "Simple cases are symmetric" 3393! ! 3394 3395!Object methodsFor: 'undo' stamp: 'sw 11/16/2000 14:42'! 3396refineRedoTarget: target selector: aSymbol arguments: arguments in: refineBlock 3397 "Any object can override this method to refine its redo specification" 3398 3399 ^ refineBlock 3400 value: target 3401 value: aSymbol 3402 value: arguments! ! 3403 3404!Object methodsFor: 'undo' stamp: 'sw 11/16/2000 14:42'! 3405refineUndoTarget: target selector: aSymbol arguments: arguments in: refineBlock 3406 "Any object can override this method to refine its undo specification" 3407 3408 ^ refineBlock 3409 value: target 3410 value: aSymbol 3411 value: arguments! ! 3412 3413!Object methodsFor: 'undo' stamp: 'di 9/11/2000 20:30'! 3414rememberCommand: aCommand 3415 "Remember the given command for undo" 3416 Preferences useUndo ifFalse: [^ self]. "get out quickly" 3417 ^ self commandHistory rememberCommand: aCommand! ! 3418 3419!Object methodsFor: 'undo' stamp: 'di 9/11/2000 20:30'! 3420rememberUndoableAction: actionBlock named: caption 3421 | cmd result | 3422 cmd _ Command new cmdWording: caption. 3423 cmd undoTarget: self selector: #undoFromCapturedState: argument: self capturedState. 3424 result _ actionBlock value. 3425 cmd redoTarget: self selector: #redoFromCapturedState: argument: self capturedState. 3426 self rememberCommand: cmd. 3427 ^ result! ! 3428 3429!Object methodsFor: 'undo' stamp: 'di 9/11/2000 20:32'! 3430undoFromCapturedState: st 3431 "May be overridden in subclasses. See also capturedState" 3432 3433 self copyFrom: st 3434! ! 3435 3436 3437!Object methodsFor: 'updating'! 3438changed 3439 "Receiver changed in a general way; inform all the dependents by 3440 sending each dependent an update: message." 3441 3442 self changed: self! ! 3443 3444!Object methodsFor: 'updating'! 3445changed: aParameter 3446 "Receiver changed. The change is denoted by the argument aParameter. 3447 Usually the argument is a Symbol that is part of the dependent's change 3448 protocol. Inform all of the dependents." 3449 3450 self dependents do: [:aDependent | aDependent update: aParameter]! ! 3451 3452!Object methodsFor: 'updating' stamp: 'nk 2/17/2004 11:12'! 3453changed: anAspect with: anObject 3454 "Receiver changed. The change is denoted by the argument anAspect. 3455 Usually the argument is a Symbol that is part of the dependent's change 3456 protocol. Inform all of the dependents. Also pass anObject for additional information." 3457 3458 self dependents do: [:aDependent | aDependent update: anAspect with: anObject]! ! 3459 3460!Object methodsFor: 'updating' stamp: 'sw 10/12/1999 18:15'! 3461handledListVerification 3462 "When a self-updating PluggableListMorph lazily checks to see the state of affairs, it first gives its model an opportunity to handle the list verification itself (this is appropriate for some models, such as VersionsBrowser); if a list's model has indeed handled things itself, it returns true here" 3463 3464 ^ false! ! 3465 3466!Object methodsFor: 'updating' stamp: 'sw 10/31/1999 00:15'! 3467noteSelectionIndex: anInteger for: aSymbol 3468 "backstop"! ! 3469 3470!Object methodsFor: 'updating'! 3471okToChange 3472 "Allows a controller to ask this of any model" 3473 ^ true! ! 3474 3475!Object methodsFor: 'updating' stamp: 'sw 10/19/1999 14:39'! 3476updateListsAndCodeIn: aWindow 3477 self canDiscardEdits ifFalse: [^ self]. 3478 aWindow updatablePanes do: [:aPane | aPane verifyContents]! ! 3479 3480!Object methodsFor: 'updating' stamp: 'sma 2/29/2000 20:05'! 3481update: aParameter 3482 "Receive a change notice from an object of whom the receiver is a 3483 dependent. The default behavior is to do nothing; a subclass might want 3484 to change itself in some way." 3485 3486 ^ self! ! 3487 3488!Object methodsFor: 'updating' stamp: 'nk 2/17/2004 11:13'! 3489update: anAspect with: anObject 3490 "Receive a change notice from an object of whom the receiver is a 3491 dependent. The default behavior is to call update:, 3492 which by default does nothing; a subclass might want 3493 to change itself in some way." 3494 3495 ^ self update: anAspect! ! 3496 3497!Object methodsFor: 'updating' stamp: 'jm 8/20/1998 18:26'! 3498windowIsClosing 3499 "This message is used to inform a models that its window is closing. Most models do nothing, but some, such as the Debugger, must do some cleanup. Note that this mechanism must be used with care by models that support multiple views, since one view may be closed while others left open." 3500! ! 3501 3502 3503!Object methodsFor: 'user interface' stamp: 'sw 10/4/1999 08:13'! 3504addModelItemsToWindowMenu: aMenu 3505 "aMenu is being constructed to be presented to the user in response to the user's pressing on the menu widget in the title bar of a morphic window. Here, the model is given the opportunity to add any model-specific items to the menu, whose default target is the SystemWindow itself."! ! 3506 3507!Object methodsFor: 'user interface' stamp: 'sw 10/5/1998 14:39'! 3508addModelMenuItemsTo: aCustomMenu forMorph: aMorph hand: aHandMorph 3509 "The receiver serves as the model for aMorph; a menu is being constructed for the morph, and here the receiver is able to add its own items" 3510! ! 3511 3512!Object methodsFor: 'user interface' stamp: 'sma 11/12/2000 11:43'! 3513asExplorerString 3514 ^ self printString! ! 3515 3516!Object methodsFor: 'user interface' stamp: 'sw 7/13/1999 15:53'! 3517defaultBackgroundColor 3518 "Answer the color to be used as the base window color for a window whose model is an object of the receiver's class" 3519 3520 ^ Preferences windowColorFor: self class name! ! 3521 3522!Object methodsFor: 'user interface'! 3523defaultLabelForInspector 3524 "Answer the default label to be used for an Inspector window on the receiver." 3525 3526 ^ self class name! ! 3527 3528!Object methodsFor: 'user interface' stamp: 'RAA 7/10/2000 08:11'! 3529eToyStreamedRepresentationNotifying: aWidget 3530 3531 | outData | 3532 [ outData _ SmartRefStream streamedRepresentationOf: self ] 3533 on: ProgressInitiationException 3534 do: [ :ex | 3535 ex sendNotificationsTo: [ :min :max :curr | 3536 aWidget ifNotNil: [aWidget flashIndicator: #working]. 3537 ]. 3538 ]. 3539 ^outData 3540! ! 3541 3542!Object methodsFor: 'user interface' stamp: 'ar 9/27/2005 20:29'! 3543explore 3544 ^ToolSet explore: self! ! 3545 3546!Object methodsFor: 'user interface' stamp: 'sw 8/15/97 17:25'! 3547fullScreenSize 3548 "Answer the size to which a window displaying the receiver should be set" 3549 | adj | 3550 adj _ (3 * Preferences scrollBarWidth) @ 0. 3551 ^ Rectangle origin: adj extent: (DisplayScreen actualScreenSize - adj)! ! 3552 3553!Object methodsFor: 'user interface' stamp: 'RAA 6/21/1999 11:27'! 3554hasContentsInExplorer 3555 3556 ^self basicSize > 0 or: [self class allInstVarNames isEmpty not] 3557! ! 3558 3559!Object methodsFor: 'user interface' stamp: 'rbb 3/1/2005 09:28'! 3560inform: aString 3561 "Display a message for the user to read and then dismiss. 6/9/96 sw" 3562 3563 aString isEmptyOrNil ifFalse: [UIManager default inform: aString]! ! 3564 3565!Object methodsFor: 'user interface'! 3566initialExtent 3567 "Answer the desired extent for the receiver when a view on it is first opened on the screen. 3568 5/22/96 sw: in the absence of any override, obtain from RealEstateAgent" 3569 3570 ^ RealEstateAgent standardWindowExtent! ! 3571 3572!Object methodsFor: 'user interface' stamp: 'ar 9/27/2005 20:30'! 3573inspectWithLabel: aLabel 3574 "Create and schedule an Inspector in which the user can examine the receiver's variables." 3575 ^ToolSet inspect: self label: aLabel! ! 3576 3577!Object methodsFor: 'user interface' stamp: 'sw 6/12/2001 11:09'! 3578launchPartVia: aSelector 3579 "Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins" 3580 3581 | aMorph | 3582 aMorph _ self perform: aSelector. 3583 aMorph setProperty: #beFullyVisibleAfterDrop toValue: true. 3584 aMorph openInHand! ! 3585 3586!Object methodsFor: 'user interface' stamp: 'sw 6/17/2004 01:47'! 3587launchPartVia: aSelector label: aString 3588 "Obtain a morph by sending aSelector to self, and attach it to the morphic hand. This provides a general protocol for parts bins" 3589 3590 | aMorph | 3591 aMorph _ self perform: aSelector. 3592 aMorph setNameTo: (ActiveWorld unusedMorphNameLike: aString). 3593 aMorph setProperty: #beFullyVisibleAfterDrop toValue: true. 3594 aMorph openInHand! ! 3595 3596!Object methodsFor: 'user interface' stamp: 'sw 10/16/2000 11:11'! 3597launchTileToRefer 3598 "Create a tile to reference the receiver, and attach it to the hand" 3599 3600 self currentHand attachMorph: self tileToRefer! ! 3601 3602!Object methodsFor: 'user interface' stamp: 'di 5/11/1999 22:26'! 3603modelSleep 3604 "A window with me as model is being exited or collapsed or closed. 3605 Default response is no-op" ! ! 3606 3607!Object methodsFor: 'user interface' stamp: 'di 5/11/1999 22:01'! 3608modelWakeUp 3609 "A window with me as model is being entered or expanded. Default response is no-op" ! ! 3610 3611!Object methodsFor: 'user interface' stamp: 'sw 10/16/1999 22:45'! 3612modelWakeUpIn: aWindow 3613 "A window with me as model is being entered or expanded. Default response is no-op" 3614 self modelWakeUp! ! 3615 3616!Object methodsFor: 'user interface' stamp: 'sw 3/8/1999 15:27'! 3617mouseUpBalk: evt 3618 "A button I own got a mouseDown, but the user moved out before letting up. Certain kinds of objects (so-called 'radio buttons', for example, and other structures that must always have some selection, e.g. PaintBoxMorph) wish to take special action in this case; this default does nothing." 3619! ! 3620 3621!Object methodsFor: 'user interface' stamp: 'sw 8/22/97 13:14'! 3622newTileMorphRepresentative 3623 ^ TileMorph new setLiteral: self! ! 3624 3625!Object methodsFor: 'user interface' stamp: 'jcg 11/1/2001 13:13'! 3626notYetImplemented 3627 self inform: 'Not yet implemented (', thisContext sender printString, ')'! ! 3628 3629!Object methodsFor: 'user interface' stamp: 'di 6/10/1998 15:06'! 3630windowReqNewLabel: labelString 3631 "My window's title has been edited. 3632 Return true if this is OK, and override for further behavior." 3633 3634 ^ true! ! 3635 3636 3637!Object methodsFor: 'viewer' stamp: 'sw 10/16/2000 10:35'! 3638assureUniClass 3639 "If the receiver is not yet an instance of a uniclass, create a uniclass for it and make the receiver become an instance of that class." 3640 3641 | anInstance | 3642 self belongsToUniClass ifTrue: [^ self]. 3643 anInstance _ self class instanceOfUniqueClass. 3644 self become: (self as: anInstance class). 3645 ^ anInstance! ! 3646 3647!Object methodsFor: 'viewer' stamp: 'sw 10/16/2000 10:41'! 3648belongsToUniClass 3649 "Answer whether the receiver belongs to a uniclass. For the moment (this is not entirely satisfactory) this is precisely equated with the classname ending in a digit" 3650 3651 ^ self class name endsWithDigit! ! 3652 3653!Object methodsFor: 'viewer' stamp: 'sw 12/11/2000 15:37'! 3654browseOwnClassSubProtocol 3655 "Open up a ProtocolBrowser on the subprotocol of the receiver" 3656 3657 ProtocolBrowser openSubProtocolForClass: self class 3658! ! 3659 3660!Object methodsFor: 'viewer' stamp: 'sw 8/4/2001 00:51'! 3661categoriesForViewer: aViewer 3662 "Answer a list of categories to offer in the given viewer" 3663 3664 ^ aViewer currentVocabulary categoryListForInstance: self ofClass: self class limitClass: aViewer limitClass! ! 3665 3666!Object methodsFor: 'viewer' stamp: 'sw 8/3/2001 22:08'! 3667categoriesForVocabulary: aVocabulary limitClass: aLimitClass 3668 "Answer a list of categories of methods for the receiver when using the given vocabulary, given that one considers only methods that are implemented not further away than aLimitClass" 3669 3670 ^ aVocabulary categoryListForInstance: self ofClass: self class limitClass: aLimitClass! ! 3671 3672!Object methodsFor: 'viewer' stamp: 'sw 10/25/2000 07:20'! 3673chooseNewNameForReference 3674 "Offer an opportunity for the receiver, presumed already to be known in the References registry, to be renamed" 3675 3676 | nameSym current newName | 3677 current _ References keyAtValue: self ifAbsent: [^ self error: 'not found in References']. 3678 3679 newName _ FillInTheBlank request: 'Please enter new name' initialAnswer: current. 3680 "Want to user some better way of determining the validity of the chosen identifier, and also want to give more precise diagnostic if the string the user types in is not acceptable. Work to be done here." 3681 3682 newName isEmpty ifTrue: [^ nil]. 3683 ((Scanner isLiteralSymbol: newName) and: [(newName includes: $:) not]) 3684 ifTrue: 3685 [nameSym _ newName capitalized asSymbol. 3686 (((References includesKey: nameSym) not and: 3687 [(Smalltalk includesKey: nameSym) not]) and: 3688 [(ScriptingSystem allKnownClassVariableNames includes: nameSym) not]) 3689 ifTrue: 3690 [(References associationAt: current) key: nameSym. 3691 References rehash. 3692 ^ nameSym]]. 3693 self inform: 'Sorry, that name is not available.'. 3694 ^ nil! ! 3695 3696!Object methodsFor: 'viewer' stamp: 'sw 8/3/2001 21:22'! 3697defaultLimitClassForVocabulary: aVocabulary 3698 "Answer the class to use, by default, as the limit class on a protocol browser or viewer opened up on the receiver, within the purview of the Vocabulary provided" 3699 3700 ^ (aVocabulary isKindOf: FullVocabulary) 3701 ifTrue: 3702 [self class superclass == Object 3703 ifTrue: 3704 [self class] 3705 ifFalse: 3706 [self class superclass]] 3707 ifFalse: 3708 [ProtoObject]! ! 3709 3710!Object methodsFor: 'viewer' stamp: 'sw 2/14/2000 14:24'! 3711defaultNameStemForInstances 3712 "Answer a basis for names of default instances of the receiver. The default is to let the class specify, but certain instances will want to override. (PasteUpMorphs serving as Worlds come to mind" 3713 3714 ^ self class defaultNameStemForInstances! ! 3715 3716!Object methodsFor: 'viewer' stamp: 'sw 5/22/2001 16:53'! 3717elementTypeFor: aStringOrSymbol vocabulary: aVocabulary 3718 "Answer a symbol characterizing what kind of element aStringOrSymbol represents. Realistically, at present, this always just returns #systemScript; a prototyped but not-incorporated architecture supported use of a leading colon to characterize an inst var of a system class, and for the moment we still see its remnant here." 3719 3720 self flag: #deferred. "a loose end in the non-player case" 3721 ^ #systemScript! ! 3722 3723!Object methodsFor: 'viewer' stamp: 'sw 5/4/2001 07:04'! 3724externalName 3725 "Answer an external name by which the receiver is known. Generic implementation here is a transitional backstop. probably" 3726 3727 ^ self nameForViewer! ! 3728 3729!Object methodsFor: 'viewer' stamp: 'sw 5/4/2001 07:06'! 3730graphicForViewerTab 3731 "When a Viewer is open on the receiver, its tab needs some graphic to show to the user. Answer a form or a morph to serve that purpose. A generic image is used for arbitrary objects, but note my reimplementors" 3732 3733 ^ ScriptingSystem formAtKey: 'Image'! ! 3734 3735!Object methodsFor: 'viewer' stamp: 'sw 5/4/2001 07:08'! 3736hasUserDefinedSlots 3737 "Answer whether the receiver has any user-defined slots, in the omniuser sense of the term. This is needed to allow Viewers to look at any object, not just at Players." 3738 3739 ^ false! ! 3740 3741!Object methodsFor: 'viewer' stamp: 'sw 8/22/2002 14:07'! 3742infoFor: anElement inViewer: aViewer 3743 "The user made a gesture asking for info/menu relating to me. Some of the messages dispatched here are not yet available in this image" 3744 3745 | aMenu elementType | 3746 elementType _ self elementTypeFor: anElement vocabulary: aViewer currentVocabulary. 3747 ((elementType = #systemSlot) | (elementType == #userSlot)) 3748 ifTrue: [^ self slotInfoButtonHitFor: anElement inViewer: aViewer]. 3749 self flag: #deferred. "Use a traditional MenuMorph, and reinstate the pacify thing" 3750 aMenu _ MenuMorph new defaultTarget: aViewer. 3751 #( ('implementors' browseImplementorsOf:) 3752 ('senders' browseSendersOf:) 3753 ('versions' browseVersionsOf:) 3754 - 3755 ('browse full' browseMethodFull:) 3756 ('inheritance' browseMethodInheritance:) 3757 - 3758 ('about this method' aboutMethod:)) do: 3759 3760 [:pair | 3761 pair = '-' 3762 ifTrue: 3763 [aMenu addLine] 3764 ifFalse: 3765 [aMenu add: pair first target: aViewer selector: pair second argument: anElement]]. 3766 aMenu addLine. 3767 aMenu defaultTarget: self. 3768 #( ('destroy script' removeScript:) 3769 ('rename script' renameScript:) 3770 ('pacify script' pacifyScript:)) do: 3771 [:pair | 3772 aMenu add: pair first target: self selector: pair second argument: anElement]. 3773 3774 aMenu addLine. 3775 aMenu add: 'show categories....' target: aViewer selector: #showCategoriesFor: argument: anElement. 3776 aMenu items size == 0 ifTrue: "won't happen at the moment a/c the above" 3777 [aMenu add: 'ok' action: nil]. "in case it was a slot -- weird, transitional" 3778 3779 aMenu addTitle: anElement asString, ' (', elementType, ')'. 3780 3781 aMenu popUpInWorld: self currentWorld. 3782 ! ! 3783 3784!Object methodsFor: 'viewer' stamp: 'sw 9/26/2001 11:58'! 3785initialTypeForSlotNamed: aName 3786 "Answer the initial type to be ascribed to the given instance variable" 3787 3788 ^ #Object! ! 3789 3790!Object methodsFor: 'viewer' stamp: 'ar 5/26/2001 16:13'! 3791isPlayerLike 3792 "Return true if the receiver is a player-like object" 3793 ^false! ! 3794 3795!Object methodsFor: 'viewer' stamp: 'nk 9/11/2004 16:53'! 3796methodInterfacesInPresentationOrderFrom: interfaceList forCategory: aCategory 3797 "Answer the interface list sorted in desired presentation order, using a 3798 static master-ordering list, q.v. The category parameter allows an 3799 escape in case one wants to apply different order strategies in different 3800 categories, but for now a single master-priority-ordering is used -- see 3801 the comment in method EToyVocabulary.masterOrderingOfPhraseSymbols" 3802 3803 | masterOrder ordered unordered index | 3804 masterOrder := Vocabulary eToyVocabulary masterOrderingOfPhraseSymbols. 3805 ordered := SortedCollection sortBlock: [:a :b | a key < b key]. 3806 unordered := SortedCollection sortBlock: [:a :b | a wording < b wording]. 3807 3808 interfaceList do: [:interface | 3809 index := masterOrder indexOf: interface elementSymbol. 3810 index isZero 3811 ifTrue: [unordered add: interface] 3812 ifFalse: [ordered add: index -> interface]]. 3813 3814 ^ Array 3815 streamContents: [:stream | 3816 ordered do: [:assoc | stream nextPut: assoc value]. 3817 stream nextPutAll: unordered]! ! 3818 3819!Object methodsFor: 'viewer' stamp: 'sw 10/24/2000 11:36'! 3820newScriptorAround: aPhraseTileMorph 3821 "Sprout a scriptor around aPhraseTileMorph, thus making a new script. This is where generalized scriptors will be threaded in" 3822 3823 ^ nil! ! 3824 3825!Object methodsFor: 'viewer' stamp: 'sw 10/25/2000 17:42'! 3826offerViewerMenuForEvt: anEvent morph: aMorph 3827 "Offer the viewer's primary menu to the user. aMorph is some morph within the viewer itself, the one within which a mousedown triggered the need for this menu, and it is used only to retrieve the Viewer itself" 3828 3829 self offerViewerMenuFor: (aMorph ownerThatIsA: StandardViewer) event: anEvent! ! 3830 3831!Object methodsFor: 'viewer' stamp: 'sw 8/11/2002 02:03'! 3832offerViewerMenuFor: aViewer event: evt 3833 "Offer the primary Viewer menu to the user. Copied up from Player code, but most of the functions suggested here don't work for non-Player objects, many aren't even defined, some relate to exploratory sw work not yet reflected in the current corpus. We are early in the life cycle of this method..." 3834 3835 | aMenu | 3836 aMenu _ MenuMorph new defaultTarget: self. 3837 aMenu addStayUpItem. 3838 aMenu title: '**CAUTION -- UNDER CONSTRUCTION!!** 3839Many things may not work!! 3840', self nameForViewer. 3841 (aViewer affordsUniclass and: [self belongsToUniClass not]) ifTrue: 3842 [aMenu add: 'give me a Uniclass' action: #assureUniClass. 3843 aMenu addLine]. 3844 aMenu add: 'choose vocabulary...' target: aViewer action: #chooseVocabulary. 3845 aMenu add: 'choose limit class...' target: aViewer action: #chooseLimitClass. 3846 aMenu add: 'add search pane' target: aViewer action: #addSearchPane. 3847 aMenu balloonTextForLastItem: 'Specify which class should be the most generic one to have its methods shown in this Viewer'. 3848 aMenu addLine. 3849 3850 self belongsToUniClass ifTrue: 3851 [aMenu add: 'add a new instance variable' target: self selector: #addInstanceVariableIn: argument: aViewer. 3852 aMenu add: 'add a new script' target: aViewer selector: #newPermanentScriptIn: argument: aViewer. 3853 aMenu addLine. 3854 aMenu add: 'make my class be first-class' target: self selector: #makeFirstClassClassIn: argument: aViewer. 3855 aMenu add: 'move my changes up to my superclass' target: self action: #promoteChangesToSuperclass. 3856 aMenu addLine]. 3857 3858 aMenu add: 'tear off a tile' target: self selector: #launchTileToRefer. 3859 aMenu addLine. 3860 3861 aMenu add: 'inspect me' target: self selector: #inspect. 3862 aMenu add: 'inspect my class' target: self class action: #inspect. 3863 aMenu addLine. 3864 3865 aMenu add: 'browse vocabulary' action: #haveFullProtocolBrowsed. 3866 aMenu add: 'inspect this Viewer' target: aViewer action: #inspect. 3867 3868 aMenu popUpEvent: evt in: aViewer currentWorld 3869 3870" 3871 aMenu add: 'references to me' target: aViewer action: #browseReferencesToObject. 3872 aMenu add: 'toggle scratch pane' target: aViewer selector: #toggleScratchPane. 3873 aMenu add: 'make a nascent script for me' target: aViewer selector: #makeNascentScript. 3874 aMenu add: 'rename me' target: aViewer selector: #chooseNewNameForReference. 3875 aMenu add: 'browse full' action: #browseOwnClassFull. 3876 aMenu add: 'browse hierarchy' action: #browseOwnClassHierarchy. 3877 aMenu add: 'set user level...' target: aViewer action: #setUserLevel. 3878 aMenu add: 'browse sub-protocol' action: #browseOwnClassSubProtocol. 3879 aMenu addLine. 3880 3881"! ! 3882 3883!Object methodsFor: 'viewer' stamp: 'sw 1/22/2001 15:20'! 3884renameScript: oldSelector 3885 "prompt the user for a new selector and apply it. Presently only works for players" 3886 3887 self notYetImplemented! ! 3888 3889!Object methodsFor: 'viewer' stamp: 'sw 8/10/2004 11:53'! 3890tilePhrasesForCategory: aCategorySymbol inViewer: aViewer 3891 "Return a collection of phrases for the category." 3892 3893 | interfaces | 3894 interfaces _ self methodInterfacesForCategory: aCategorySymbol inVocabulary: aViewer currentVocabulary limitClass: aViewer limitClass. 3895 interfaces _ self methodInterfacesInPresentationOrderFrom: interfaces forCategory: aCategorySymbol. 3896 ^ self tilePhrasesForMethodInterfaces: interfaces inViewer: aViewer! ! 3897 3898!Object methodsFor: 'viewer' stamp: 'sw 8/10/2004 11:53'! 3899tilePhrasesForMethodInterfaces: methodInterfaceList inViewer: aViewer 3900 "Return a collection of ViewerLine objects corresponding to the method-interface list provided. The resulting list will be in the same order as the incoming list, but may be smaller if the viewer's vocbulary suppresses some of the methods, or if, in classic tiles mode, the selector requires more arguments than can be handled." 3901 3902 | toSuppress interfaces resultType itsSelector | 3903 toSuppress _ aViewer currentVocabulary phraseSymbolsToSuppress. 3904 interfaces _ methodInterfaceList reject: [:int | toSuppress includes: int selector]. 3905 Preferences universalTiles ifFalse: "Classic tiles have their limitations..." 3906 [interfaces _ interfaces select: 3907 [:int | 3908 itsSelector _ int selector. 3909 itsSelector numArgs < 2 or: 3910 "The lone two-arg loophole in classic tiles" 3911 [#(color:sees:) includes: itsSelector]]]. 3912 3913 ^ interfaces collect: 3914 [:aMethodInterface | 3915 ((resultType _ aMethodInterface resultType) notNil and: [resultType ~~ #unknown]) 3916 ifTrue: 3917 [aViewer phraseForVariableFrom: aMethodInterface] 3918 ifFalse: 3919 [aViewer phraseForCommandFrom: aMethodInterface]]! ! 3920 3921!Object methodsFor: 'viewer' stamp: 'sw 8/10/2004 12:23'! 3922tilePhrasesForSelectorList: aList inViewer: aViewer 3923 "Particular to the search facility in viewers. Answer a list, in appropriate order, of ViewerLine objects to put into the viewer." 3924 3925 | interfaces aVocab | 3926 aVocab _ aViewer currentVocabulary. 3927 interfaces _ self 3928 methodInterfacesInPresentationOrderFrom: 3929 (aList collect: [:aSel | aVocab methodInterfaceForSelector: aSel class: self class]) 3930 forCategory: #search. 3931 ^ self tilePhrasesForMethodInterfaces: interfaces inViewer: aViewer! ! 3932 3933!Object methodsFor: 'viewer' stamp: 'sw 5/4/2001 04:51'! 3934tileToRefer 3935 "Answer a reference tile that comprises an alias to me" 3936 3937 ^ TileMorph new setToReferTo: self! ! 3938 3939!Object methodsFor: 'viewer' stamp: 'sd 3/30/2005 22:04'! 3940uniqueInstanceVariableNameLike: aString excluding: takenNames 3941 "Answer a nice instance-variable name to be added to the receiver which resembles aString, making sure it does not coincide with any element in takenNames" 3942 3943 | okBase uniqueName usedNames | 3944 usedNames _ self class allInstVarNamesEverywhere. 3945 usedNames removeAllFoundIn: self class instVarNames. 3946 usedNames addAll: takenNames. 3947 okBase _ Scanner wellFormedInstanceVariableNameFrom: aString. 3948 3949 uniqueName _ Utilities keyLike: okBase satisfying: 3950 [:aKey | (usedNames includes: aKey) not]. 3951 3952 ^ uniqueName! ! 3953 3954!Object methodsFor: 'viewer' stamp: 'sw 11/21/2001 15:16'! 3955uniqueNameForReference 3956 "Answer a nice name by which the receiver can be referred to by other objects. At present this uses a global References dictionary to hold the database of references, but in due course this will need to acquire some locality" 3957 3958 | aName nameSym stem knownClassVars | 3959 (aName _ self uniqueNameForReferenceOrNil) ifNotNil: [^ aName]. 3960 (stem _ self knownName) ifNil: 3961 [stem _ self defaultNameStemForInstances asString]. 3962 stem _ stem select: [:ch | ch isLetter or: [ch isDigit]]. 3963 stem size == 0 ifTrue: [stem _ 'A']. 3964 stem first isLetter ifFalse: 3965 [stem _ 'A', stem]. 3966 stem _ stem capitalized. 3967 knownClassVars _ ScriptingSystem allKnownClassVariableNames. 3968 aName _ Utilities keyLike: stem satisfying: 3969 [:jinaLake | 3970 nameSym _ jinaLake asSymbol. 3971 ((References includesKey: nameSym) not and: 3972 [(Smalltalk includesKey: nameSym) not]) and: 3973 [(knownClassVars includes: nameSym) not]]. 3974 3975 References at: (aName _ aName asSymbol) put: self. 3976 ^ aName! ! 3977 3978!Object methodsFor: 'viewer' stamp: 'md 1/17/2006 17:58'! 3979uniqueNameForReferenceFrom: proposedName 3980 "Answer a satisfactory symbol, similar to the proposedName but obeying the rules, to represent the receiver" 3981 3982 | aName nameSym stem okay | 3983 proposedName = self uniqueNameForReferenceOrNil 3984 ifTrue: [^ proposedName]. "No change" 3985 3986 stem _ proposedName select: [:ch | ch isLetter or: [ch isDigit]]. 3987 stem size == 0 ifTrue: [stem _ 'A']. 3988 stem first isLetter ifFalse: 3989 [stem _ 'A', stem]. 3990 stem _ stem capitalized. 3991 aName _ Utilities keyLike: stem satisfying: 3992 [:jinaLake | 3993 nameSym _ jinaLake asSymbol. 3994 okay _ true. 3995 (self class bindingOf: nameSym) ifNotNil: [okay _ false "don't use it"]. 3996 okay]. 3997 ^ aName asSymbol! ! 3998 3999!Object methodsFor: 'viewer' stamp: 'sw 3/15/2004 23:01'! 4000uniqueNameForReferenceOrNil 4001 "If the receiver has a unique name for reference, return it here, else return nil" 4002 4003 ^ References keyAtValue: self ifAbsent: [nil]! ! 4004 4005!Object methodsFor: 'viewer' stamp: 'ar 5/16/2001 01:40'! 4006updateThresholdForGraphicInViewerTab 4007 "When a Viewer is open on the receiver, its tab needs some graphic to show to the user. Computing this graphic can take quite some time so we want to make the update frequency depending on how long it takes to compute the thumbnail. The threshold returned by this method defines that the viewer will update at most every 'threshold * timeItTakesToDraw' milliseconds. Thus, if the time for computing the receiver's thumbnail is 200 msecs and the the threshold is 10, the viewer will update at most every two seconds." 4008 ^20 "seems to be a pretty good general choice"! ! 4009 4010!Object methodsFor: 'viewer' stamp: 'sw 3/9/2001 13:48'! 4011usableMethodInterfacesIn: aListOfMethodInterfaces 4012 "Filter aList, returning a subset list of apt phrases" 4013 4014 ^ aListOfMethodInterfaces 4015! ! 4016 4017 4018!Object methodsFor: 'world hacking' stamp: 'ar 3/17/2001 23:45'! 4019couldOpenInMorphic 4020 4021 "is there an obvious morphic world in which to open a new morph?" 4022 4023 ^World notNil or: [ActiveWorld notNil]! ! 4024 4025 4026!Object methodsFor: 'private'! 4027errorImproperStore 4028 "Create an error notification that an improper store was attempted." 4029 4030 self error: 'Improper store into indexable object'! ! 4031 4032!Object methodsFor: 'private'! 4033errorNonIntegerIndex 4034 "Create an error notification that an improper object was used as an index." 4035 4036 self error: 'only integers should be used as indices'! ! 4037 4038!Object methodsFor: 'private' stamp: 'yo 6/29/2004 11:37'! 4039errorNotIndexable 4040 "Create an error notification that the receiver is not indexable." 4041 4042 self error: ('Instances of {1} are not indexable' translated format: {self class name})! ! 4043 4044!Object methodsFor: 'private'! 4045errorSubscriptBounds: index 4046 "Create an error notification that an improper integer was used as an index." 4047 4048 self error: 'subscript is out of bounds: ' , index printString! ! 4049 4050!Object methodsFor: 'private' stamp: 'ar 2/6/2004 14:47'! 4051primitiveError: aString 4052 "This method is called when the error handling results in a recursion in 4053 calling on error: or halt or halt:." 4054 4055 | context | 4056 (String 4057 streamContents: 4058 [:s | 4059 s nextPutAll: '***System error handling failed***'. 4060 s cr; nextPutAll: aString. 4061 context _ thisContext sender sender. 4062 20 timesRepeat: [context == nil ifFalse: [s cr; print: (context _ context sender)]]. 4063 s cr; nextPutAll: '-------------------------------'. 4064 s cr; nextPutAll: 'Type CR to enter an emergency evaluator.'. 4065 s cr; nextPutAll: 'Type any other character to restart.']) 4066 displayAt: 0 @ 0. 4067 [Sensor keyboardPressed] whileFalse. 4068 Sensor keyboard = Character cr ifTrue: [Transcripter emergencyEvaluator]. 4069 Smalltalk isMorphic 4070 ifTrue: [World install "init hands and redisplay"] 4071 ifFalse: [ScheduledControllers searchForActiveController]! ! 4072 4073!Object methodsFor: 'private'! 4074species 4075 "Answer the preferred class for reconstructing the receiver. For example, 4076 collections create new collections whenever enumeration messages such as 4077 collect: or select: are invoked. The new kind of collection is determined by 4078 the species of the original collection. Species and class are not always the 4079 same. For example, the species of Interval is Array." 4080 4081 ^self class! ! 4082 4083!Object methodsFor: 'private'! 4084storeAt: offset inTempFrame: aContext 4085 "This message had to get sent to an expression already on the stack 4086 as a Block argument being accessed by the debugger. 4087 Just re-route it to the temp frame." 4088 ^ aContext tempAt: offset put: self! ! 4089 4090"-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "! 4091 4092Object class 4093 instanceVariableNames: ''! 4094 4095!Object class methodsFor: '*Pinesoft-Widgets' stamp: 'gvc 4/17/2007 17:40'! 4096taskbarIcon 4097 "Answer the icon for an instance of the receiver in a task bar 4098 or nil for the default." 4099 4100 ^nil! ! 4101 4102 4103!Object class methodsFor: '*magritte-model-accessing' stamp: 'lr 3/27/2006 15:47'! 4104description 4105 ^ MADescriptionBuilder for: self! ! 4106 4107 4108!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 02:00'! 4109flushDependents 4110 DependentsFields keysAndValuesDo:[:key :dep| 4111 key ifNotNil:[key removeDependent: nil]. 4112 ]. 4113 DependentsFields finalizeValues.! ! 4114 4115!Object class methodsFor: 'class initialization' stamp: 'rw 2/10/2002 13:09'! 4116flushEvents 4117 "Object flushEvents" 4118 4119 EventManager flushEvents. ! ! 4120 4121!Object class methodsFor: 'class initialization' stamp: 'rww 10/2/2001 07:35'! 4122initialize 4123 "Object initialize" 4124 DependentsFields ifNil:[self initializeDependentsFields].! ! 4125 4126!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:41'! 4127initializeDependentsFields 4128 "Object initialize" 4129 DependentsFields _ WeakIdentityKeyDictionary new. 4130! ! 4131 4132!Object class methodsFor: 'class initialization' stamp: 'ar 2/11/2001 01:45'! 4133reInitializeDependentsFields 4134 "Object reInitializeDependentsFields" 4135 | oldFields | 4136 oldFields _ DependentsFields. 4137 DependentsFields _ WeakIdentityKeyDictionary new. 4138 oldFields keysAndValuesDo:[:obj :deps| 4139 deps do:[:d| obj addDependent: d]]. 4140! ! 4141 4142 4143!Object class methodsFor: 'documentation'! 4144howToModifyPrimitives 4145 "You are allowed to write methods which specify primitives, but please use 4146 caution. If you make a subclass of a class which contains a primitive method, 4147 the subclass inherits the primitive. The message which is implemented 4148 primitively may be overridden in the subclass (E.g., see at:put: in String's 4149 subclass Symbol). The primitive behavior can be invoked using super (see 4150 Symbol string:). 4151 4152 A class which attempts to mimic the behavior of another class without being 4153 its subclass may or may not be able to use the primitives of the original class. 4154 In general, if the instance variables read or written by a primitive have the 4155 same meanings and are in the same fields in both classes, the primitive will 4156 work. 4157 4158 For certain frequently used 'special selectors', the compiler emits a 4159 send-special-selector bytecode instead of a send-message bytecode. 4160 Special selectors were created because they offer two advantages. Code 4161 which sends special selectors compiles into fewer bytes than normal. For 4162 some pairs of receiver classes and special selectors, the interpreter jumps 4163 directly to a primitive routine without looking up the method in the class. 4164 This is much faster than a normal message lookup. 4165 4166 A selector which is a special selector solely in order to save space has a 4167 normal behavior. Methods whose selectors are special in order to 4168 gain speed contain the comment, 'No Lookup'. When the interpreter 4169 encounters a send-special-selector bytecode, it checks the class of the 4170 receiver and the selector. If the class-selector pair is a no-lookup pair, 4171 then the interpreter swiftly jumps to the routine which implements the 4172 corresponding primitive. (A special selector whose receiver is not of the 4173 right class to make a no-lookup pair, is looked up normally). The pairs are 4174 listed below. No-lookup methods contain a primitive number specification, 4175 <primitive: xx>, which is redundant. Since the method is not normally looked 4176 up, deleting the primitive number specification cannot prevent this 4177 primitive from running. If a no-lookup primitive fails, the method is looked 4178 up normally, and the expressions in it are executed. 4179 4180 No Lookup pairs of (class, selector) 4181 4182 SmallInteger with any of + - * / \\ bitOr: bitShift: bitAnd: // 4183 SmallInteger with any of = ~= > < >= <= 4184 Any class with == 4185 Any class with @ 4186 Point with either of x y 4187 ContextPart with blockCopy: 4188 BlockContext with either of value value: 4189 " 4190 4191 self error: 'comment only'! ! 4192 4193!Object class methodsFor: 'documentation'! 4194whatIsAPrimitive 4195 "Some messages in the system are responded to primitively. A primitive 4196 response is performed directly by the interpreter rather than by evaluating 4197 expressions in a method. The methods for these messages indicate the 4198 presence of a primitive response by including <primitive: xx> before the 4199 first expression in the method. 4200 4201 Primitives exist for several reasons. Certain basic or 'primitive' 4202 operations cannot be performed in any other way. Smalltalk without 4203 primitives can move values from one variable to another, but cannot add two 4204 SmallIntegers together. Many methods for arithmetic and comparison 4205 between numbers are primitives. Some primitives allow Smalltalk to 4206 communicate with I/O devices such as the disk, the display, and the keyboard. 4207 Some primitives exist only to make the system run faster; each does the same 4208 thing as a certain Smalltalk method, and its implementation as a primitive is 4209 optional. 4210 4211 When the Smalltalk interpreter begins to execute a method which specifies a 4212 primitive response, it tries to perform the primitive action and to return a 4213 result. If the routine in the interpreter for this primitive is successful, 4214 it will return a value and the expressions in the method will not be evaluated. 4215 If the primitive routine is not successful, the primitive 'fails', and the 4216 Smalltalk expressions in the method are executed instead. These 4217 expressions are evaluated as though the primitive routine had not been 4218 called. 4219 4220 The Smalltalk code that is evaluated when a primitive fails usually 4221 anticipates why that primitive might fail. If the primitive is optional, the 4222 expressions in the method do exactly what the primitive would have done (See 4223 Number @). If the primitive only works on certain classes of arguments, the 4224 Smalltalk code tries to coerce the argument or appeals to a superclass to find 4225 a more general way of doing the operation (see SmallInteger +). If the 4226 primitive is never supposed to fail, the expressions signal an error (see 4227 SmallInteger asFloat). 4228 4229 Each method that specifies a primitive has a comment in it. If the primitive is 4230 optional, the comment will say 'Optional'. An optional primitive that is not 4231 implemented always fails, and the Smalltalk expressions do the work 4232 instead. 4233 4234 If a primitive is not optional, the comment will say, 'Essential'. Some 4235 methods will have the comment, 'No Lookup'. See Object 4236 howToModifyPrimitives for an explanation of special selectors which are 4237 not looked up. 4238 4239 For the primitives for +, -, *, and bitShift: in SmallInteger, and truncated 4240 in Float, the primitive constructs and returns a 16-bit 4241 LargePositiveInteger when the result warrants it. Returning 16-bit 4242 LargePositiveIntegers from these primitives instead of failing is 4243 optional in the same sense that the LargePositiveInteger arithmetic 4244 primitives are optional. The comments in the SmallInteger primitives say, 4245 'Fails if result is not a SmallInteger', even though the implementor has the 4246 option to construct a LargePositiveInteger. For further information on 4247 primitives, see the 'Primitive Methods' part of the chapter on the formal 4248 specification of the interpreter in the Smalltalk book." 4249 4250 self error: 'comment only'! ! 4251 4252 4253!Object class methodsFor: 'file list services' stamp: 'nk 6/12/2004 11:41'! 4254fileReaderServicesForDirectory: aFileDirectory 4255 "Backstop" 4256 ^#()! ! 4257 4258!Object class methodsFor: 'file list services' stamp: 'nk 6/12/2004 11:30'! 4259fileReaderServicesForFile: fullName suffix: suffix 4260 "Backstop" 4261 ^#()! ! 4262 4263!Object class methodsFor: 'file list services' stamp: 'md 2/15/2006 17:20'! 4264services 4265 "Backstop" 4266 ^#()! ! 4267 4268 4269!Object class methodsFor: 'instance creation' stamp: 'sw 1/23/2003 09:45'! 4270categoryForUniclasses 4271 "Answer the default system category into which to place unique-class instances" 4272 4273 ^ 'UserObjects'! ! 4274 4275!Object class methodsFor: 'instance creation' stamp: 'sw 7/28/97 15:56'! 4276chooseUniqueClassName 4277 | i className | 4278 i _ 1. 4279 [className _ (self name , i printString) asSymbol. 4280 Smalltalk includesKey: className] 4281 whileTrue: [i _ i + 1]. 4282 ^ className! ! 4283 4284!Object class methodsFor: 'instance creation' stamp: 'tk 8/22/1998 08:22'! 4285initialInstance 4286 "Answer the first instance of the receiver, generate an error if there is one already" 4287 "self instanceCount > 0 ifTrue: [self error: 'instance(s) already exist.']." 4288 "Debugging test that is very slow" 4289 ^ self new! ! 4290 4291!Object class methodsFor: 'instance creation' stamp: 'sw 5/5/2000 09:30'! 4292initializedInstance 4293 ^ self new! ! 4294 4295!Object class methodsFor: 'instance creation' stamp: 'sw 10/16/2000 10:58'! 4296instanceOfUniqueClass 4297 "Answer an instance of a unique subclass of the receiver" 4298 4299 ^ self instanceOfUniqueClassWithInstVarString: '' andClassInstVarString: ''! ! 4300 4301!Object class methodsFor: 'instance creation' stamp: 'tk 8/22/1998 08:27'! 4302instanceOfUniqueClassWithInstVarString: instVarString andClassInstVarString: classInstVarString 4303 "Create a unique class for the receiver, and answer an instance of it" 4304 4305 ^ (self newUniqueClassInstVars: instVarString 4306 classInstVars: classInstVarString) initialInstance! ! 4307 4308!Object class methodsFor: 'instance creation' stamp: 'sw 10/23/1999 22:51'! 4309isUniClass 4310 ^ false! ! 4311 4312!Object class methodsFor: 'instance creation' stamp: 'ajh 5/23/2002 00:35'! 4313newFrom: aSimilarObject 4314 "Create an object that has similar contents to aSimilarObject. 4315 If the classes have any instance varaibles with the same names, copy them across. 4316 If this is bad for a class, override this method." 4317 4318 ^ (self isVariable 4319 ifTrue: [self basicNew: aSimilarObject basicSize] 4320 ifFalse: [self basicNew] 4321 ) copySameFrom: aSimilarObject! ! 4322 4323!Object class methodsFor: 'instance creation' stamp: 'tk 6/29/1998 12:11'! 4324newUniqueClassInstVars: instVarString classInstVars: classInstVarString 4325 "Create a unique class for the receiver" 4326 4327 | aName aClass | 4328 self isSystemDefined ifFalse: 4329 [^ superclass newUniqueClassInstVars: instVarString classInstVars: classInstVarString]. 4330 aName _ self chooseUniqueClassName. 4331 aClass _ self subclass: aName instanceVariableNames: instVarString 4332 classVariableNames: '' poolDictionaries: '' category: self categoryForUniclasses. 4333 classInstVarString size > 0 ifTrue: 4334 [aClass class instanceVariableNames: classInstVarString]. 4335 ^ aClass! ! 4336 4337!Object class methodsFor: 'instance creation' stamp: 'sw 7/28/97 15:56'! 4338newUserInstance 4339 "Answer an instance of an appropriate class to serve as a user object in the containment hierarchy" 4340 4341 ^ self instanceOfUniqueClass! ! 4342 4343!Object class methodsFor: 'instance creation' stamp: 'nk 8/30/2004 07:57'! 4344readCarefullyFrom: textStringOrStream 4345 "Create an object based on the contents of textStringOrStream. Return an error instead of putting up a SyntaxError window." 4346 4347 | object | 4348 (Compiler couldEvaluate: textStringOrStream) 4349 ifFalse: [^ self error: 'expected String, Stream, or Text']. 4350 object _ Compiler evaluate: textStringOrStream for: nil 4351 notifying: #error: "signal we want errors" logged: false. 4352 (object isKindOf: self) ifFalse: [self error: self name, ' expected']. 4353 ^object! ! 4354 4355!Object class methodsFor: 'instance creation' stamp: 'nk 8/30/2004 07:57'! 4356readFrom: textStringOrStream 4357 "Create an object based on the contents of textStringOrStream." 4358 4359 | object | 4360 (Compiler couldEvaluate: textStringOrStream) 4361 ifFalse: [^ self error: 'expected String, Stream, or Text']. 4362 object _ Compiler evaluate: textStringOrStream. 4363 (object isKindOf: self) ifFalse: [self error: self name, ' expected']. 4364 ^object! ! 4365 4366 4367!Object class methodsFor: 'objects from disk' stamp: 'tk 1/8/97'! 4368createFrom: aSmartRefStream size: varsOnDisk version: instVarList 4369 "Create an instance of me so objects on the disk can be read in. Tricky part is computing the size if variable. Inst vars will be filled in later. " 4370 4371 ^ self isVariable 4372 ifFalse: [self basicNew] 4373 ifTrue: ["instVarList is names of old class's inst vars plus a version number" 4374 self basicNew: (varsOnDisk - (instVarList size - 1))] 4375! ! 4376 4377 4378!Object class methodsFor: 'window color' stamp: 'nk 6/10/2004 08:10'! 4379windowColorSpecification 4380 "Answer a WindowColorSpec object that declares my preference. 4381 This is a backstop for classes that don't otherwise define a preference." 4382 4383 ^ WindowColorSpec classSymbol: self name 4384 wording: 'Default' brightColor: #white 4385 pastelColor: #white 4386 helpMessage: 'Other windows without color preferences.'! ! 4387 4388 4389!Object class methodsFor: 'private' stamp: 'mir 8/22/2001 15:20'! 4390releaseExternalSettings 4391 "Do nothing as a default"! ! 4392 4393 4394Object initialize! 4395